PROYECTO_FINAL
David Cárdenas Giler-Susana Carrillo-Jorge Merchán-Alexandra Wilches
2022-12-22
1. Instalación de paquetes y Carga de Librerías
#install.packages("easypackages")
library("easypackages") # instalamos y cargamos los paquetes
paq <- c("car", "ggplot2", "ggcorrplot", "dplyr", "readxl", "FactoMineR",
"corrplot", "GGally", "factoextra", "Hmisc", "PerformanceAnalytics", "dummy")
packages(paq)## Loading required package: car## Loading required package: carData## Loading required package: ggplot2## Loading required package: ggcorrplot## Loading required package: dplyr##
## Attaching package: 'dplyr'## The following object is masked from 'package:car':
##
## recode## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union## Loading required package: readxl## Loading required package: FactoMineR## Loading required package: corrplot## corrplot 0.92 loaded## Loading required package: GGally## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2## Loading required package: factoextra## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa## Loading required package: Hmisc## Loading required package: lattice## Loading required package: survival## Loading required package: Formula##
## Attaching package: 'Hmisc'## The following objects are masked from 'package:dplyr':
##
## src, summarize## The following objects are masked from 'package:base':
##
## format.pval, units## Loading required package: PerformanceAnalytics## Loading required package: xts## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric##
## Attaching package: 'xts'## The following objects are masked from 'package:dplyr':
##
## first, last##
## Attaching package: 'PerformanceAnalytics'## The following object is masked from 'package:graphics':
##
## legend## Loading required package: dummy## dummy 0.1.3## dummyNews()## All packages loaded successfullyset.seed(567)2. Data
Importamos y verificamos la data:
getwd()## [1] "/Users/davidxaviercardenasgiler12promax/Library/CloudStorage/OneDrive-Personal/LENGUAJES PROGRAMACIÓN/RSTUDIO/CURSO DATA & ANALYTICS/PROYECTOS/PROYECTO 02/PROYETO_FINAL"data_nutricion <- read_excel("Caso. Data_Nutricion (1).xlsx")
str(data_nutricion)## tibble [652 × 23] (S3: tbl_df/tbl/data.frame)
## $ N° : num [1:652] 1 2 3 4 5 6 7 8 9 10 ...
## $ Individuo : chr [1:652] "Persona 1" "Persona 2" "Persona 3" "Persona 4" ...
## $ sexo : chr [1:652] "F" "F" "F" "F" ...
## $ talla : num [1:652] 156 166 151 152 160 ...
## $ edad : num [1:652] 16 16 16 16 16 16 16 16 16 16 ...
## $ peso_kg : chr [1:652] "71.2" "61" "49.1" "54.6" ...
## $ circun_cuello : num [1:652] 35.7 31.8 30.5 32.6 30.1 33.9 30.5 31.2 37.5 30.8 ...
## $ IMC : num [1:652] 29.6 22.4 21.6 23.1 22.3 ...
## $ circun_cintura : num [1:652] 90 80.9 72 74.4 79.6 ...
## $ cadera : chr [1:652] "98" "100.5" "86" "88.4" ...
## $ ind_cintura_cadera : num [1:652] 0.918 0.805 0.837 0.842 0.813 ...
## $ ind_cintura_estatura : num [1:652] 0.578 0.486 0.476 0.49 0.497 ...
## $ por_grasa_corporal : num [1:652] 36.4 28.8 29.9 27.9 30.3 ...
## $ masa_corporal_magra_kg : num [1:652] 45.3 43.4 34.4 39.4 40.4 ...
## $ pliegue_cutaneo_BICEPS : chr [1:652] "13" "5" "13" "5" ...
## $ pliegue_cutaneo_TRICEPS : chr [1:652] "27" "19" "18" "19" ...
## $ pliegue_cutaneo_ESCAPULAR : chr [1:652] "32" "15" "18" "15" ...
## $ pliegue_cutaneo_SUPRAILIACO: chr [1:652] "34" "22" "17" "18" ...
## $ clasif_diagnos_talla_edad : chr [1:652] "RIESGO DE TALLA BAJA" "TALLA NORMAL" "RIESGO DE TALLA BAJA" "RIESGO DE TALLA BAJA" ...
## $ clasif_diagnos_IMC : chr [1:652] "OBESIDAD" "NORMAL" "NORMAL" "NORMAL" ...
## $ clasif_perimetro_abdominal : chr [1:652] "ALTO RIESGO" "BAJO RIESGO" "BAJO RIESGO" "BAJO RIESGO" ...
## $ clasif_anemia : chr [1:652] "NO PRESENTA ANEMIA" "NO PRESENTA ANEMIA" "ANEMIA LEVE" "NO PRESENTA ANEMIA" ...
## $ target : num [1:652] 1 0 0 0 1 0 1 0 1 0 ...** Nota: 652 Observaciones y 23 variables cargadas.
Seleccionamos solo la data que vamos a utilizar en el PCA:
dnutricion <- data_nutricion
dnutricion <- dnutricion[,c(-1:-2)]
str(dnutricion)## tibble [652 × 21] (S3: tbl_df/tbl/data.frame)
## $ sexo : chr [1:652] "F" "F" "F" "F" ...
## $ talla : num [1:652] 156 166 151 152 160 ...
## $ edad : num [1:652] 16 16 16 16 16 16 16 16 16 16 ...
## $ peso_kg : chr [1:652] "71.2" "61" "49.1" "54.6" ...
## $ circun_cuello : num [1:652] 35.7 31.8 30.5 32.6 30.1 33.9 30.5 31.2 37.5 30.8 ...
## $ IMC : num [1:652] 29.6 22.4 21.6 23.1 22.3 ...
## $ circun_cintura : num [1:652] 90 80.9 72 74.4 79.6 ...
## $ cadera : chr [1:652] "98" "100.5" "86" "88.4" ...
## $ ind_cintura_cadera : num [1:652] 0.918 0.805 0.837 0.842 0.813 ...
## $ ind_cintura_estatura : num [1:652] 0.578 0.486 0.476 0.49 0.497 ...
## $ por_grasa_corporal : num [1:652] 36.4 28.8 29.9 27.9 30.3 ...
## $ masa_corporal_magra_kg : num [1:652] 45.3 43.4 34.4 39.4 40.4 ...
## $ pliegue_cutaneo_BICEPS : chr [1:652] "13" "5" "13" "5" ...
## $ pliegue_cutaneo_TRICEPS : chr [1:652] "27" "19" "18" "19" ...
## $ pliegue_cutaneo_ESCAPULAR : chr [1:652] "32" "15" "18" "15" ...
## $ pliegue_cutaneo_SUPRAILIACO: chr [1:652] "34" "22" "17" "18" ...
## $ clasif_diagnos_talla_edad : chr [1:652] "RIESGO DE TALLA BAJA" "TALLA NORMAL" "RIESGO DE TALLA BAJA" "RIESGO DE TALLA BAJA" ...
## $ clasif_diagnos_IMC : chr [1:652] "OBESIDAD" "NORMAL" "NORMAL" "NORMAL" ...
## $ clasif_perimetro_abdominal : chr [1:652] "ALTO RIESGO" "BAJO RIESGO" "BAJO RIESGO" "BAJO RIESGO" ...
## $ clasif_anemia : chr [1:652] "NO PRESENTA ANEMIA" "NO PRESENTA ANEMIA" "ANEMIA LEVE" "NO PRESENTA ANEMIA" ...
## $ target : num [1:652] 1 0 0 0 1 0 1 0 1 0 ...Conversión de variables cualitativas a factor y caracter a numércias
dnutricion$sexo <- as.factor(dnutricion$sexo)
dnutricion$talla <- as.numeric(dnutricion$talla)
dnutricion$clasif_anemia <- as.factor(dnutricion$clasif_anemia)
dnutricion$clasif_diagnos_talla_edad <- as.factor(dnutricion$clasif_diagnos_talla_edad)
dnutricion$clasif_diagnos_IMC <- as.factor(dnutricion$clasif_diagnos_IMC)
dnutricion$clasif_perimetro_abdominal<- as.factor(dnutricion$clasif_perimetro_abdominal)
dnutricion$cadera <- as.numeric(dnutricion$cadera)
dnutricion$pliegue_cutaneo_BICEPS<- as.numeric(dnutricion$pliegue_cutaneo_BICEPS)
dnutricion$pliegue_cutaneo_TRICEPS<- as.numeric(dnutricion$pliegue_cutaneo_TRICEPS)
dnutricion$pliegue_cutaneo_ESCAPULAR<- as.numeric(dnutricion$pliegue_cutaneo_ESCAPULAR)
dnutricion$pliegue_cutaneo_SUPRAILIACO<- as.numeric(dnutricion$pliegue_cutaneo_SUPRAILIACO)
dnutricion$peso_kg <- as.numeric(dnutricion$peso_kg)
str(dnutricion)## tibble [652 × 21] (S3: tbl_df/tbl/data.frame)
## $ sexo : Factor w/ 2 levels "F","M": 1 1 1 1 1 1 2 2 1 2 ...
## $ talla : num [1:652] 156 166 151 152 160 ...
## $ edad : num [1:652] 16 16 16 16 16 16 16 16 16 16 ...
## $ peso_kg : num [1:652] 71.2 61 49.1 54.6 58 70.8 47.4 49.3 91 50.4 ...
## $ circun_cuello : num [1:652] 35.7 31.8 30.5 32.6 30.1 33.9 30.5 31.2 37.5 30.8 ...
## $ IMC : num [1:652] 29.6 22.4 21.6 23.1 22.3 ...
## $ circun_cintura : num [1:652] 90 80.9 72 74.4 79.6 ...
## $ cadera : num [1:652] 98 100.5 86 88.4 97.9 ...
## $ ind_cintura_cadera : num [1:652] 0.918 0.805 0.837 0.842 0.813 ...
## $ ind_cintura_estatura : num [1:652] 0.578 0.486 0.476 0.49 0.497 ...
## $ por_grasa_corporal : num [1:652] 36.4 28.8 29.9 27.9 30.3 ...
## $ masa_corporal_magra_kg : num [1:652] 45.3 43.4 34.4 39.4 40.4 ...
## $ pliegue_cutaneo_BICEPS : num [1:652] 13 5 13 5 10 11 3.5 5.5 25 3 ...
## $ pliegue_cutaneo_TRICEPS : num [1:652] 27 19 18 19 19 25 7 12 21 7 ...
## $ pliegue_cutaneo_ESCAPULAR : num [1:652] 32 15 18 15 20 18 6 10.5 25 8.5 ...
## $ pliegue_cutaneo_SUPRAILIACO: num [1:652] 34 22 17 18 19 20 6 11.5 NA 9 ...
## $ clasif_diagnos_talla_edad : Factor w/ 4 levels "RIESGO DE TALLA BAJA",..: 1 4 1 1 4 4 1 1 4 4 ...
## $ clasif_diagnos_IMC : Factor w/ 5 levels "DELGADEZ","NORMAL",..: 3 2 2 2 2 5 4 2 3 4 ...
## $ clasif_perimetro_abdominal : Factor w/ 2 levels "ALTO RIESGO",..: 1 2 2 2 2 1 2 2 1 2 ...
## $ clasif_anemia : Factor w/ 4 levels "ANEMIA LEVE",..: 3 3 1 3 3 NA 3 3 3 3 ...
## $ target : num [1:652] 1 0 0 0 1 0 1 0 1 0 ...# Datos perdidos en el DataFrame
which(is.na(dnutricion)) # filas que tienen datos perdidos## [1] 14 15 27 28 29 30 31 32 108 109 110 267
## [13] 268 269 270 413 455 482 483 484 543 574 575 576
## [25] 577 689 690 691 692 742 743 744 902 903 904 971
## [37] 972 1010 1011 1160 1190 1193 1715 1818 2219 2220 2221 2466
## [49] 2563 2886 2887 2928 2929 3023 3062 3127 3873 3977 4192 4193
## [61] 4256 4257 4258 4259 4260 4261 4270 4452 4983 5078 5230 5281
## [73] 5295 5469 5470 5471 5472 5473 5571 5624 5668 5875 6214 6230
## [85] 6481 6543 6879 6939 7185 7385 7440 7441 7442 7443 7444 7489
## [97] 7490 7491 7492 7493 7494 7517 7897 7951 8170 8360 8428 8490
## [109] 8497 8813 8819 8833 8898 8987 9071 9200 9416 9482 9545 9637
## [121] 9684 9789 9913 10561 10643 10702 10793 11020 11037 11102 11150 11350
## [133] 11545 11546 11547 11548 11549 11550 11551 11552 11634 11700 11808 11858
## [145] 11950 11994 12324 12394 12452 12458 12461 12646 13006 13037 13038Determinamos el total de datos perdidos
sum(is.na(dnutricion))## [1] 155Número de datos perdidos por cada variable
apply(is.na(dnutricion), 2, sum)## sexo talla
## 25 17
## edad peso_kg
## 2 5
## circun_cuello IMC
## 7 1
## circun_cintura cadera
## 11 2
## ind_cintura_cadera ind_cintura_estatura
## 11 4
## por_grasa_corporal masa_corporal_magra_kg
## 3 14
## pliegue_cutaneo_BICEPS pliegue_cutaneo_TRICEPS
## 5 8
## pliegue_cutaneo_ESCAPULAR pliegue_cutaneo_SUPRAILIACO
## 6 2
## clasif_diagnos_talla_edad clasif_diagnos_IMC
## 6 13
## clasif_perimetro_abdominal clasif_anemia
## 5 8
## target
## 0Vista porcentual de datos perdidos por variable
apply(is.na(dnutricion), 2, mean) # % de datos perdidos por variable## sexo talla
## 0.038343558 0.026073620
## edad peso_kg
## 0.003067485 0.007668712
## circun_cuello IMC
## 0.010736196 0.001533742
## circun_cintura cadera
## 0.016871166 0.003067485
## ind_cintura_cadera ind_cintura_estatura
## 0.016871166 0.006134969
## por_grasa_corporal masa_corporal_magra_kg
## 0.004601227 0.021472393
## pliegue_cutaneo_BICEPS pliegue_cutaneo_TRICEPS
## 0.007668712 0.012269939
## pliegue_cutaneo_ESCAPULAR pliegue_cutaneo_SUPRAILIACO
## 0.009202454 0.003067485
## clasif_diagnos_talla_edad clasif_diagnos_IMC
## 0.009202454 0.019938650
## clasif_perimetro_abdominal clasif_anemia
## 0.007668712 0.012269939
## target
## 0.000000000Imputamos: Imputación Paramétrica
#dnutricion_imp <- impute(dnutricion, classes = list(
# factor = imputeMode(),
# integer = imputeMedian(),
# numeric = imputeMedian()),
# dummy.classes = c("integer","factor"), dummy.type = "numeric")
#dnutricion_imp = dnutricion_imp$data[,1:min(dim(dnutricion))]Cargo dnutricion.Rds
dnutricion <- readRDS("dnutricion.rds") #levantamos
dnutricion_imp <- dnutricionNos aseguramos que el nuevo dataframe no hay datos NaN
sum(is.na(dnutricion_imp)) #total datos perdidos## [1] 0sapply(dnutricion_imp, function(x) sum(is.na(x)))## sexo talla
## 0 0
## edad peso_kg
## 0 0
## circun_cuello IMC
## 0 0
## circun_cintura cadera
## 0 0
## ind_cintura_cadera ind_cintura_estatura
## 0 0
## por_grasa_corporal masa_corporal_magra_kg
## 0 0
## pliegue_cutaneo_BICEPS pliegue_cutaneo_TRICEPS
## 0 0
## pliegue_cutaneo_ESCAPULAR pliegue_cutaneo_SUPRAILIACO
## 0 0
## clasif_diagnos_talla_edad clasif_diagnos_IMC
## 0 0
## clasif_perimetro_abdominal clasif_anemia
## 0 0
## target
## 0dnutricion <- dnutricion_imp
saveRDS(dnutricion, file="dnutricion.rds") # guardamos
#dnutricion <- readRDS("dnutricon.rds") #levantamos
str(dnutricion)## 'data.frame': 652 obs. of 21 variables:
## $ sexo : Factor w/ 2 levels "F","M": 1 1 1 1 1 1 2 2 1 2 ...
## $ talla : num 156 166 151 152 160 ...
## $ edad : num 16 16 16 16 16 16 16 16 16 16 ...
## $ peso_kg : num 71.2 61 49.1 54.6 58 70.8 47.4 49.3 91 50.4 ...
## $ circun_cuello : num 35.7 31.8 30.5 32.6 30.1 33.9 30.5 31.2 37.5 30.8 ...
## $ IMC : num 29.6 22.4 21.6 23.1 22.3 ...
## $ circun_cintura : num 90 80.9 72 74.4 79.6 ...
## $ cadera : num 98 100.5 86 88.4 97.9 ...
## $ ind_cintura_cadera : num 0.918 0.805 0.837 0.842 0.813 ...
## $ ind_cintura_estatura : num 0.578 0.486 0.476 0.49 0.497 ...
## $ por_grasa_corporal : num 36.4 28.8 29.9 27.9 30.3 ...
## $ masa_corporal_magra_kg : num 45.3 43.4 34.4 39.4 40.4 ...
## $ pliegue_cutaneo_BICEPS : num 13 5 13 5 10 11 3.5 5.5 25 3 ...
## $ pliegue_cutaneo_TRICEPS : num 27 19 18 19 19 25 7 12 21 7 ...
## $ pliegue_cutaneo_ESCAPULAR : num 32 15 18 15 20 18 6 10.5 25 8.5 ...
## $ pliegue_cutaneo_SUPRAILIACO: num 34 22 17 18 19 20 6 11.5 15 9 ...
## $ clasif_diagnos_talla_edad : Factor w/ 4 levels "RIESGO DE TALLA BAJA",..: 1 4 1 1 4 4 1 1 4 4 ...
## $ clasif_diagnos_IMC : Factor w/ 5 levels "DELGADEZ","NORMAL",..: 3 2 2 2 2 5 4 2 3 4 ...
## $ clasif_perimetro_abdominal : Factor w/ 2 levels "ALTO RIESGO",..: 1 2 2 2 2 1 2 2 1 2 ...
## $ clasif_anemia : Factor w/ 4 levels "ANEMIA LEVE",..: 3 3 1 3 3 3 3 3 3 3 ...
## $ target : num 1 0 0 0 1 0 1 0 1 0 ...Convirtiendo variables cualitativas en Dummy
#Variables_dummy <- dummy(df1[, 1]) # index
variables_dummy <- dummy(dnutricion [, c(1, 17, 18, 19,20)]) # indexConvierto variables dummy a numéricas
#df1$Variables_dummy<-dummy(df1 [, c(1, 17, 18, 19,20)])
variables_dummy<- variables_dummy %>%
mutate_all(as.numeric)
str(variables_dummy)## 'data.frame': 652 obs. of 17 variables:
## $ sexo_F : num 1 1 1 1 1 1 0 0 1 0 ...
## $ sexo_M : num 0 0 0 0 0 0 1 1 0 1 ...
## $ clasif_diagnos_talla_edad_RIESGO.DE.TALLA.BAJA: num 1 0 1 1 0 0 1 1 0 0 ...
## $ clasif_diagnos_talla_edad_TALLA.BAJA : num 0 0 0 0 0 0 0 0 0 0 ...
## $ clasif_diagnos_talla_edad_TALLA.BAJA.SEVERA : num 0 0 0 0 0 0 0 0 0 0 ...
## $ clasif_diagnos_talla_edad_TALLA.NORMAL : num 0 1 0 0 1 1 0 0 1 1 ...
## $ clasif_diagnos_IMC_DELGADEZ : num 0 0 0 0 0 0 0 0 0 0 ...
## $ clasif_diagnos_IMC_NORMAL : num 0 1 1 1 1 0 0 1 0 0 ...
## $ clasif_diagnos_IMC_OBESIDAD : num 1 0 0 0 0 0 0 0 1 0 ...
## $ clasif_diagnos_IMC_RIESGO.DE.BAJO.PESO : num 0 0 0 0 0 0 1 0 0 1 ...
## $ clasif_diagnos_IMC_SOBREPESO : num 0 0 0 0 0 1 0 0 0 0 ...
## $ clasif_perimetro_abdominal_ALTO.RIESGO : num 1 0 0 0 0 1 0 0 1 0 ...
## $ clasif_perimetro_abdominal_BAJO.RIESGO : num 0 1 1 1 1 0 1 1 0 1 ...
## $ clasif_anemia_ANEMIA.LEVE : num 0 0 1 0 0 0 0 0 0 0 ...
## $ clasif_anemia_ANEMIA.MODERADA : num 0 0 0 0 0 0 0 0 0 0 ...
## $ clasif_anemia_NO.PRESENTA.ANEMIA : num 1 1 0 1 1 1 1 1 1 1 ...
## $ clasif_anemia_VALORES.INCORRECTOS : num 0 0 0 0 0 0 0 0 0 0 ...Trabajo solo con variables numéricas
dx1<-dnutricion[, c(-1, -17, -18, -19, -20)]
str(dx1)## 'data.frame': 652 obs. of 16 variables:
## $ talla : num 156 166 151 152 160 ...
## $ edad : num 16 16 16 16 16 16 16 16 16 16 ...
## $ peso_kg : num 71.2 61 49.1 54.6 58 70.8 47.4 49.3 91 50.4 ...
## $ circun_cuello : num 35.7 31.8 30.5 32.6 30.1 33.9 30.5 31.2 37.5 30.8 ...
## $ IMC : num 29.6 22.4 21.6 23.1 22.3 ...
## $ circun_cintura : num 90 80.9 72 74.4 79.6 ...
## $ cadera : num 98 100.5 86 88.4 97.9 ...
## $ ind_cintura_cadera : num 0.918 0.805 0.837 0.842 0.813 ...
## $ ind_cintura_estatura : num 0.578 0.486 0.476 0.49 0.497 ...
## $ por_grasa_corporal : num 36.4 28.8 29.9 27.9 30.3 ...
## $ masa_corporal_magra_kg : num 45.3 43.4 34.4 39.4 40.4 ...
## $ pliegue_cutaneo_BICEPS : num 13 5 13 5 10 11 3.5 5.5 25 3 ...
## $ pliegue_cutaneo_TRICEPS : num 27 19 18 19 19 25 7 12 21 7 ...
## $ pliegue_cutaneo_ESCAPULAR : num 32 15 18 15 20 18 6 10.5 25 8.5 ...
## $ pliegue_cutaneo_SUPRAILIACO: num 34 22 17 18 19 20 6 11.5 15 9 ...
## $ target : num 1 0 0 0 1 0 1 0 1 0 ...Creamos un dataframe uniendo los dataframe creados El propósito es tener solo variables cuantitativas
dfnum<- bind_cols(dx1, variables_dummy)
str(dfnum)## 'data.frame': 652 obs. of 33 variables:
## $ talla : num 156 166 151 152 160 ...
## $ edad : num 16 16 16 16 16 16 16 16 16 16 ...
## $ peso_kg : num 71.2 61 49.1 54.6 58 70.8 47.4 49.3 91 50.4 ...
## $ circun_cuello : num 35.7 31.8 30.5 32.6 30.1 33.9 30.5 31.2 37.5 30.8 ...
## $ IMC : num 29.6 22.4 21.6 23.1 22.3 ...
## $ circun_cintura : num 90 80.9 72 74.4 79.6 ...
## $ cadera : num 98 100.5 86 88.4 97.9 ...
## $ ind_cintura_cadera : num 0.918 0.805 0.837 0.842 0.813 ...
## $ ind_cintura_estatura : num 0.578 0.486 0.476 0.49 0.497 ...
## $ por_grasa_corporal : num 36.4 28.8 29.9 27.9 30.3 ...
## $ masa_corporal_magra_kg : num 45.3 43.4 34.4 39.4 40.4 ...
## $ pliegue_cutaneo_BICEPS : num 13 5 13 5 10 11 3.5 5.5 25 3 ...
## $ pliegue_cutaneo_TRICEPS : num 27 19 18 19 19 25 7 12 21 7 ...
## $ pliegue_cutaneo_ESCAPULAR : num 32 15 18 15 20 18 6 10.5 25 8.5 ...
## $ pliegue_cutaneo_SUPRAILIACO : num 34 22 17 18 19 20 6 11.5 15 9 ...
## $ target : num 1 0 0 0 1 0 1 0 1 0 ...
## $ sexo_F : num 1 1 1 1 1 1 0 0 1 0 ...
## $ sexo_M : num 0 0 0 0 0 0 1 1 0 1 ...
## $ clasif_diagnos_talla_edad_RIESGO.DE.TALLA.BAJA: num 1 0 1 1 0 0 1 1 0 0 ...
## $ clasif_diagnos_talla_edad_TALLA.BAJA : num 0 0 0 0 0 0 0 0 0 0 ...
## $ clasif_diagnos_talla_edad_TALLA.BAJA.SEVERA : num 0 0 0 0 0 0 0 0 0 0 ...
## $ clasif_diagnos_talla_edad_TALLA.NORMAL : num 0 1 0 0 1 1 0 0 1 1 ...
## $ clasif_diagnos_IMC_DELGADEZ : num 0 0 0 0 0 0 0 0 0 0 ...
## $ clasif_diagnos_IMC_NORMAL : num 0 1 1 1 1 0 0 1 0 0 ...
## $ clasif_diagnos_IMC_OBESIDAD : num 1 0 0 0 0 0 0 0 1 0 ...
## $ clasif_diagnos_IMC_RIESGO.DE.BAJO.PESO : num 0 0 0 0 0 0 1 0 0 1 ...
## $ clasif_diagnos_IMC_SOBREPESO : num 0 0 0 0 0 1 0 0 0 0 ...
## $ clasif_perimetro_abdominal_ALTO.RIESGO : num 1 0 0 0 0 1 0 0 1 0 ...
## $ clasif_perimetro_abdominal_BAJO.RIESGO : num 0 1 1 1 1 0 1 1 0 1 ...
## $ clasif_anemia_ANEMIA.LEVE : num 0 0 1 0 0 0 0 0 0 0 ...
## $ clasif_anemia_ANEMIA.MODERADA : num 0 0 0 0 0 0 0 0 0 0 ...
## $ clasif_anemia_NO.PRESENTA.ANEMIA : num 1 1 0 1 1 1 1 1 1 1 ...
## $ clasif_anemia_VALORES.INCORRECTOS : num 0 0 0 0 0 0 0 0 0 0 ...Análisis Descriptivo
Coeficiente de variación
creamos una función
coeficiente.variacion<-function(x){
m = mean(x)
s = sd(x)
return ( round(s/m * 100,2))
}Coeficiente de variación de todas las columnas cuantitativas
apply(dx1, 2, FUN=coeficiente.variacion) # 1ra opción## talla edad
## 4.57 7.12
## peso_kg circun_cuello
## 14.88 6.69
## IMC circun_cintura
## 13.53 9.31
## cadera ind_cintura_cadera
## 8.02 6.52
## ind_cintura_estatura por_grasa_corporal
## 9.77 33.47
## masa_corporal_magra_kg pliegue_cutaneo_BICEPS
## 15.74 61.34
## pliegue_cutaneo_TRICEPS pliegue_cutaneo_ESCAPULAR
## 36.18 36.70
## pliegue_cutaneo_SUPRAILIACO target
## 40.53 208.59mapply(coeficiente.variacion, dx1) # 2da opción## talla edad
## 4.57 7.12
## peso_kg circun_cuello
## 14.88 6.69
## IMC circun_cintura
## 13.53 9.31
## cadera ind_cintura_cadera
## 8.02 6.52
## ind_cintura_estatura por_grasa_corporal
## 9.77 33.47
## masa_corporal_magra_kg pliegue_cutaneo_BICEPS
## 15.74 61.34
## pliegue_cutaneo_TRICEPS pliegue_cutaneo_ESCAPULAR
## 36.18 36.70
## pliegue_cutaneo_SUPRAILIACO target
## 40.53 208.59Coeficiente de variación de una variable cuantitativa
round(coeficiente.variacion(dnutricion$IMC), 2) ## [1] 13.53Gráfico Histograma de todas las variables
library(corrplot)
library(gplots)##
## Attaching package: 'gplots'## The following object is masked from 'package:PerformanceAnalytics':
##
## textplot## The following object is masked from 'package:stats':
##
## lowesslibrary(ggplot2)
library(ggplot2)
library(dplyr)
library(readr)
library(corrplot)
library(readxl)
library(gplots)
library(ParamHelpers)
library(mlr)## Warning message: 'mlr' is in 'maintenance-only' mode since July 2019.
## Future development will only happen in 'mlr3'
## (<https://mlr3.mlr-org.com>). Due to the focus on 'mlr3' there might be
## uncaught bugs meanwhile in {mlr} - please consider switching.##
## Attaching package: 'mlr'## The following object is masked from 'package:Hmisc':
##
## imputelibrary(car)
library(VIM)## Loading required package: colorspace## Loading required package: grid## VIM is ready to use.## Suggestions and bug-reports can be submitted at: https://github.com/statistikat/VIM/issues##
## Attaching package: 'VIM'## The following object is masked from 'package:datasets':
##
## sleeplibrary(dplyr)
library(stats)
library(dummy)
library(skimr)
library(DataExplorer)
plot_histogram(dnutricion)
par(mfrow = c(1, 2))
hist(dnutricion$IMC, probability = TRUE, xlab = "IMC",
col = "grey",
axes = FALSE,
main = "Histograma de IMC")
axis(1)
lines(density(dnutricion$IMC), col = "red", lwd = 2)
#par(new = TRUE)
boxplot(dnutricion$IMC ~ dnutricion$target, data = dnutricion, col = 3:5,
main="Boxplot del IMC",
xlab="target",
ylab="IMC"
) 
Análisis Cualitativo de : clasif_diagnos_IMC
summary(dnutricion$clasif_diagnos_IMC)## DELGADEZ NORMAL OBESIDAD RIESGO DE BAJO PESO
## 1 431 30 17
## SOBREPESO
## 173Análisis Cualitativo de : clasif_perimetro abdominal
summary(dnutricion$clasif_perimetro_abdominal)## ALTO RIESGO BAJO RIESGO
## 121 531# Graficamos las 2 variables cualitativas
Tabla1=table(dnutricion$clasif_diagnos_IMC)
Tabla2=table(dnutricion$clasif_perimetro_abdominal)
par(mfrow=c(1,2)) # 1 fila 2 columnas
balloonplot(t(Tabla1), main ="Gráfico No. 1",xlab ="Clasificación IMC", label = FALSE, show.margins = FALSE)
balloonplot(t(Tabla2), main ="Gráfico No. 2",xlab ="Perímetro Abdominal", label = FALSE, show.margins = FALSE)
VER LA NORMALIDAD DE LOS DATOS.
Planteamiento de Hipótesis
Ho: Los datos si están normalmente distribuidos
Ha: Los datos no están normalmente distribuidos
Nivel de significancia = 5% (0.05)
#————————————————-
1.b) Aplicamos la prueba de normalidad
# IMC
qqnorm(dnutricion$IMC)
qqline(dnutricion$IMC)
# Test: Kolmogorov-Smirnov "para la prueba de normalidad, n>50 casos"
library(nortest)
lillie.test(dnutricion$IMC)$p.value## [1] 4.109185e-08Decisión: Los datos de la variables “IMC” no están normalmente distribuidos; esto afirmamos con un nivel de confianza del 95% / nivel de significancia del 5%.
# Perímetro Abdominal
qqnorm(dnutricion$por_grasa_corporal)
qqline(dnutricion$por_grasa_corporal)
# Test: Kolmogorov-Smirnov "para la prueba de normalidad, n>50 casos"
library(nortest)
lillie.test(dnutricion$por_grasa_corporal)$p.value## [1] 8.77055e-34Decisión: Los datos de la variables “grasa corporal” no están normalmente distribuidos; esto afirmamos con un nivel de confianza del 95% / nivel de significancia del 5%.
Análisis de Componentes Principales PCA
Observando la media y la varaianza de las variables:
apply(X = dx1, MARGIN = 2, FUN = mean)## talla edad
## 158.7503067 14.7638037
## peso_kg circun_cuello
## 56.9662577 32.1602761
## IMC circun_cintura
## 22.4239663 74.6368098
## cadera ind_cintura_cadera
## 89.8757669 0.8309885
## ind_cintura_estatura por_grasa_corporal
## 0.4708023 23.5141083
## masa_corporal_magra_kg pliegue_cutaneo_BICEPS
## 43.3446643 9.1786810
## pliegue_cutaneo_TRICEPS pliegue_cutaneo_ESCAPULAR
## 15.6702454 14.3911043
## pliegue_cutaneo_SUPRAILIACO target
## 14.6595092 0.1871166Observando la varianza de las variables:
apply(X = dx1, MARGIN = 2, FUN = var)## talla edad
## 52.736666572 1.105415925
## peso_kg circun_cuello
## 71.893483362 4.626391936
## IMC circun_cintura
## 9.200066964 48.301008547
## cadera ind_cintura_cadera
## 52.005771300 0.002931376
## ind_cintura_estatura por_grasa_corporal
## 0.002114973 61.933110301
## masa_corporal_magra_kg pliegue_cutaneo_BICEPS
## 46.573967721 31.698054786
## pliegue_cutaneo_TRICEPS pliegue_cutaneo_ESCAPULAR
## 32.139942797 27.888277120
## pliegue_cutaneo_SUPRAILIACO target
## 35.298634475 0.1523376023. Análisis de correlación
#chart.Correlation(dfnum, histogram = F, pch = 19)4. Estandariza automática - PCA
nutricion_PCA <- PCA(X = dx1, scale.unit = TRUE, ncp = 64, graph = FALSE)
nutricion_PCA$eig## eigenvalue percentage of variance cumulative percentage of variance
## comp 1 7.288723953 45.55452471 45.55452
## comp 2 3.549299778 22.18312361 67.73765
## comp 3 1.257515836 7.85947397 75.59712
## comp 4 0.980274668 6.12671668 81.72384
## comp 5 0.810795837 5.06747398 86.79131
## comp 6 0.608692287 3.80432679 90.59564
## comp 7 0.468409157 2.92755723 93.52320
## comp 8 0.398958331 2.49348957 96.01669
## comp 9 0.182719967 1.14199979 97.15869
## comp 10 0.169072724 1.05670452 98.21539
## comp 11 0.131442831 0.82151770 99.03691
## comp 12 0.069906884 0.43691803 99.47383
## comp 13 0.040475734 0.25297334 99.72680
## comp 14 0.022735649 0.14209781 99.86890
## comp 15 0.011698860 0.07311788 99.94202
## comp 16 0.009277504 0.05798440 100.00000Es necesario escalar y centrar los datos para disminuir la variablidad
vamos a utilizar el método prcomp para centrar y escalar los datos
acp <- prcomp(dx1, center = TRUE, scale = TRUE)
print(acp)## Standard deviations (1, .., p=16):
## [1] 2.6997637 1.8839585 1.1213901 0.9900882 0.9004420 0.7801873 0.6844042
## [8] 0.6316315 0.4274576 0.4111845 0.3625505 0.2643991 0.2011858 0.1507835
## [15] 0.1081613 0.0963198
##
## Rotation (n x k) = (16 x 16):
## PC1 PC2 PC3 PC4
## talla 0.05679831 -0.406505560 0.379352389 0.129975978
## edad -0.05288211 -0.064974486 0.234323935 -0.940835202
## peso_kg -0.27285414 -0.306031198 0.221465441 0.112436303
## circun_cuello -0.25402590 -0.288596488 -0.089269036 0.065908227
## IMC -0.34704451 -0.061623511 -0.002911211 -0.003676120
## circun_cintura -0.31071130 -0.217544618 -0.162108447 -0.071943484
## cadera -0.31364600 -0.006368397 0.346348299 0.008371241
## ind_cintura_cadera -0.05698886 -0.303400678 -0.658141819 -0.109495746
## ind_cintura_estatura -0.32329518 -0.019816729 -0.336926998 -0.128618814
## por_grasa_corporal -0.27305541 0.329769814 0.079244066 0.002638486
## masa_corporal_magra_kg -0.06668002 -0.494651843 0.167780642 0.107567207
## pliegue_cutaneo_BICEPS -0.20471425 0.229260515 -0.006794995 0.155200678
## pliegue_cutaneo_TRICEPS -0.29340705 0.232164118 0.118014313 0.054532790
## pliegue_cutaneo_ESCAPULAR -0.31699335 0.108992761 -0.038716210 0.008454089
## pliegue_cutaneo_SUPRAILIACO -0.30382750 0.185325717 0.032493432 0.012817172
## target -0.17910650 -0.062177082 -0.017165353 0.091013649
## PC5 PC6 PC7 PC8
## talla -0.17420687 0.294986955 -0.425622791 0.105866498
## edad 0.06889005 0.164084226 -0.007005586 -0.135641069
## peso_kg -0.08218329 0.067438822 0.035293857 -0.034008961
## circun_cuello 0.05715177 -0.165546931 0.249319977 -0.558002975
## IMC 0.05748903 -0.134353433 0.306571573 -0.163159242
## circun_cintura -0.11669756 0.039066743 -0.031164738 0.413913595
## cadera -0.02590848 -0.156376370 0.189771130 0.451782705
## ind_cintura_cadera -0.15286771 0.225351003 -0.276895018 0.008564002
## ind_cintura_estatura -0.01545121 -0.107032905 0.180732867 0.343822942
## por_grasa_corporal -0.10000244 0.105908956 -0.108491242 0.049220960
## masa_corporal_magra_kg -0.03053374 0.003746136 0.105510911 -0.101478463
## pliegue_cutaneo_BICEPS -0.04551144 0.830952819 0.329258727 -0.116953984
## pliegue_cutaneo_TRICEPS -0.09672882 -0.105556287 -0.239140302 -0.083376732
## pliegue_cutaneo_ESCAPULAR -0.06786768 -0.128998212 -0.377664811 -0.261149007
## pliegue_cutaneo_SUPRAILIACO -0.14959767 -0.043889047 -0.347101942 -0.170031385
## target 0.92969771 0.128114385 -0.251935743 0.084079198
## PC9 PC10 PC11
## talla -0.002720536 0.0034810736 0.340598140
## edad -0.002900664 0.0301204285 -0.001532227
## peso_kg -0.006787985 0.0824058721 -0.451414460
## circun_cuello 0.138254293 -0.0004679393 0.541168343
## IMC -0.024158295 0.0681585954 -0.204514922
## circun_cintura 0.004902903 -0.0194384488 0.156916375
## cadera -0.031255159 -0.1588254015 0.257060687
## ind_cintura_cadera 0.031163352 0.1425299764 -0.063702780
## ind_cintura_estatura -0.002485799 -0.0344876821 0.038954799
## por_grasa_corporal 0.035919730 0.0815422064 -0.226304490
## masa_corporal_magra_kg -0.017121965 0.0275929051 -0.403563305
## pliegue_cutaneo_BICEPS -0.077368725 -0.0657067329 0.097906471
## pliegue_cutaneo_TRICEPS -0.020100600 0.7985939332 0.130033237
## pliegue_cutaneo_ESCAPULAR -0.703426743 -0.3772736663 -0.004055509
## pliegue_cutaneo_SUPRAILIACO 0.687462298 -0.3852447773 -0.092008668
## target 0.053619416 0.0175340440 -0.013932901
## PC12 PC13 PC14 PC15
## talla 0.317603747 -0.22625773 0.090128620 0.289579644
## edad -0.040041415 0.01256535 -0.008266884 0.005483026
## peso_kg 0.068485868 0.25029750 -0.685524811 0.091780584
## circun_cuello 0.078377382 0.33914706 0.009318373 0.047772599
## IMC 0.490980131 -0.63916648 0.104870734 -0.161420968
## circun_cintura -0.030185645 0.07092579 0.011102418 -0.332109512
## cadera -0.106064687 0.07488146 0.010760153 -0.333827526
## ind_cintura_cadera 0.079242521 0.02681602 0.001853046 -0.275152481
## ind_cintura_estatura -0.100446429 -0.08217467 0.024513590 0.759061531
## por_grasa_corporal 0.501395956 0.53557326 0.415512091 0.069686077
## masa_corporal_magra_kg -0.431042048 0.04642859 0.579968860 0.022860236
## pliegue_cutaneo_BICEPS -0.196744476 -0.08870109 -0.012694963 -0.010909050
## pliegue_cutaneo_TRICEPS -0.294909275 -0.12748739 -0.012475844 -0.002766947
## pliegue_cutaneo_ESCAPULAR -0.122452316 -0.03978015 -0.007045015 0.002639462
## pliegue_cutaneo_SUPRAILIACO -0.198037886 -0.17066088 -0.021279323 -0.011782557
## target -0.003373302 0.02266880 0.010134093 -0.008882648
## PC16
## talla -0.030438940
## edad -0.002924820
## peso_kg -0.013542186
## circun_cuello 0.012638608
## IMC 0.008503630
## circun_cintura 0.704167102
## cadera -0.543706498
## ind_cintura_cadera -0.447894777
## ind_cintura_estatura -0.078236915
## por_grasa_corporal -0.009981486
## masa_corporal_magra_kg -0.004278685
## pliegue_cutaneo_BICEPS -0.003071471
## pliegue_cutaneo_TRICEPS -0.004449737
## pliegue_cutaneo_ESCAPULAR 0.013950882
## pliegue_cutaneo_SUPRAILIACO 0.002768494
## target -0.010060137Nos aseguramos que el nuevo dataframe no hay datos NaN
sum(is.na(dx1)) #total datos perdidos## [1] 0Los primeros 5 componentes explican el 86.79% de la varianza:
Graficamos el ACP con Plot
plot(acp, type="l")
fviz_screeplot(nutricion_PCA, addlabels = TRUE, ylim = c(0, 50))
Graficamos las observaciones sobre los dos primeros componentes principales. Dimensiones 1 y 2:
library(factoextra)
fviz_pca_ind(nutricion_PCA, geom.ind = "point",
col.ind = "#FC4E07",
axes = c(1, 2),
pointsize = 1.5) 
Dimensiones 1 y 3:
fviz_pca_ind(nutricion_PCA, geom.ind = "point",
col.ind = "#FC4E07",
axes = c(1, 3),
pointsize = 1.5) 
Dimensiones 1 y 4:
fviz_pca_ind(nutricion_PCA, geom.ind = "point",
col.ind = "#FC4E07",
axes = c(1, 4),
pointsize = 1.5) 
Dimensiones 1 y 5:
fviz_pca_ind(nutricion_PCA, geom.ind = "point",
col.ind = "#FC4E07",
axes = c(1, 5),
pointsize = 1.5) 
Vamos a identificar las variables con mayor contribución a nuestros componentes seleccionados
Dim1:
fviz_contrib(nutricion_PCA, choice = "var", axes = 1, top = 15)
Nota Explicativa: La línea roja nos indica la contribución media; toda
contribución mayor a este puede considerarse importante para el
componente.
Dim2:
fviz_contrib(nutricion_PCA, choice = "var", axes = 2, top = 15)
Dim3:
fviz_contrib(nutricion_PCA, choice = "var", axes = 3, top = 15)
Dim4:
fviz_contrib(nutricion_PCA, choice = "var", axes = 4, top = 15)
Observamos la función de los componentes Los nombres se asignarán con base en la composición de Componentes - variables
nutricion_PCA## **Results for the Principal Component Analysis (PCA)**
## The analysis was performed on 652 individuals, described by 16 variables
## *The results are available in the following objects:
##
## name description
## 1 "$eig" "eigenvalues"
## 2 "$var" "results for the variables"
## 3 "$var$coord" "coord. for the variables"
## 4 "$var$cor" "correlations variables - dimensions"
## 5 "$var$cos2" "cos2 for the variables"
## 6 "$var$contrib" "contributions of the variables"
## 7 "$ind" "results for the individuals"
## 8 "$ind$coord" "coord. for the individuals"
## 9 "$ind$cos2" "cos2 for the individuals"
## 10 "$ind$contrib" "contributions of the individuals"
## 11 "$call" "summary statistics"
## 12 "$call$centre" "mean of the variables"
## 13 "$call$ecart.type" "standard error of the variables"
## 14 "$call$row.w" "weights for the individuals"
## 15 "$call$col.w" "weights for the variables"summary(nutricion_PCA)##
## Call:
## PCA(X = dx1, scale.unit = TRUE, ncp = 64, graph = FALSE)
##
##
## Eigenvalues
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7
## Variance 7.289 3.549 1.258 0.980 0.811 0.609 0.468
## % of var. 45.555 22.183 7.859 6.127 5.067 3.804 2.928
## Cumulative % of var. 45.555 67.738 75.597 81.724 86.791 90.596 93.523
## Dim.8 Dim.9 Dim.10 Dim.11 Dim.12 Dim.13 Dim.14
## Variance 0.399 0.183 0.169 0.131 0.070 0.040 0.023
## % of var. 2.493 1.142 1.057 0.822 0.437 0.253 0.142
## Cumulative % of var. 96.017 97.159 98.215 99.037 99.474 99.727 99.869
## Dim.15 Dim.16
## Variance 0.012 0.009
## % of var. 0.073 0.058
## Cumulative % of var. 99.942 100.000
##
## Individuals (the 10 first)
## Dist Dim.1 ctr cos2 Dim.2 ctr
## 1 | 7.760 | 7.284 1.116 0.881 | 0.203 0.002
## 2 | 3.037 | 1.434 0.043 0.223 | 0.221 0.002
## 3 | 2.876 | -0.021 0.000 0.000 | -2.255 0.220
## 4 | 2.206 | 0.502 0.005 0.052 | -0.854 0.032
## 5 | 3.441 | 1.896 0.076 0.304 | -0.792 0.027
## 6 | 4.717 | 4.044 0.344 0.735 | 0.731 0.023
## 7 | 5.057 | -3.580 0.270 0.501 | 1.238 0.066
## 8 | 2.920 | -2.534 0.135 0.753 | 0.017 0.000
## 9 | 11.244 | 9.897 2.061 0.775 | 3.665 0.580
## 10 | 4.770 | -4.176 0.367 0.766 | 1.322 0.076
## cos2 Dim.3 ctr cos2
## 1 0.001 | -1.133 0.157 0.021 |
## 2 0.005 | 1.545 0.291 0.259 |
## 3 0.615 | -0.604 0.044 0.044 |
## 4 0.150 | -0.470 0.027 0.045 |
## 5 0.053 | 0.780 0.074 0.051 |
## 6 0.024 | 1.404 0.240 0.089 |
## 7 0.060 | 0.161 0.003 0.001 |
## 8 0.000 | -0.030 0.000 0.000 |
## 9 0.106 | -0.816 0.081 0.005 |
## 10 0.077 | 0.983 0.118 0.043 |
##
## Variables (the 10 first)
## Dim.1 ctr cos2 Dim.2 ctr cos2
## talla | -0.153 0.323 0.024 | 0.766 16.525 0.587 |
## edad | 0.143 0.280 0.020 | 0.122 0.422 0.015 |
## peso_kg | 0.737 7.445 0.543 | 0.577 9.366 0.332 |
## circun_cuello | 0.686 6.453 0.470 | 0.544 8.329 0.296 |
## IMC | 0.937 12.044 0.878 | 0.116 0.380 0.013 |
## circun_cintura | 0.839 9.654 0.704 | 0.410 4.733 0.168 |
## cadera | 0.847 9.837 0.717 | 0.012 0.004 0.000 |
## ind_cintura_cadera | 0.154 0.325 0.024 | 0.572 9.205 0.327 |
## ind_cintura_estatura | 0.873 10.452 0.762 | 0.037 0.039 0.001 |
## por_grasa_corporal | 0.737 7.456 0.543 | -0.621 10.875 0.386 |
## Dim.3 ctr cos2
## talla 0.425 14.391 0.181 |
## edad 0.263 5.491 0.069 |
## peso_kg 0.248 4.905 0.062 |
## circun_cuello -0.100 0.797 0.010 |
## IMC -0.003 0.001 0.000 |
## circun_cintura -0.182 2.628 0.033 |
## cadera 0.388 11.996 0.151 |
## ind_cintura_cadera -0.738 43.315 0.545 |
## ind_cintura_estatura -0.378 11.352 0.143 |
## por_grasa_corporal 0.089 0.628 0.008 |summary(acp)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.6998 1.8840 1.12139 0.99009 0.90044 0.78019 0.68440
## Proportion of Variance 0.4556 0.2218 0.07859 0.06127 0.05067 0.03804 0.02928
## Cumulative Proportion 0.4556 0.6774 0.75597 0.81724 0.86791 0.90596 0.93523
## PC8 PC9 PC10 PC11 PC12 PC13 PC14
## Standard deviation 0.63163 0.42746 0.41118 0.36255 0.26440 0.20119 0.15078
## Proportion of Variance 0.02493 0.01142 0.01057 0.00822 0.00437 0.00253 0.00142
## Cumulative Proportion 0.96017 0.97159 0.98215 0.99037 0.99474 0.99727 0.99869
## PC15 PC16
## Standard deviation 0.10816 0.09632
## Proportion of Variance 0.00073 0.00058
## Cumulative Proportion 0.99942 1.00000Graficamos la dispersión con Biplot
biplot(acp, scale=0)
pc1 <- apply(acp$rotation[, 1]*dx1, 1, sum)
pc2 <- apply(acp$rotation[, 2]*dx1, 1, sum)
pc3 <- apply(acp$rotation[, 3]*dx1, 1, sum)
pc4 <- apply(acp$rotation[, 4]*dx1, 1, sum)summary(pc1)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -201.61 -145.36 -121.84 -125.57 -106.41 -73.84Creamos el nuevo dataframe con los valores del ACP
dnutricion_acp <- dx1
dnutricion_acp$pc1 <- pc1
dnutricion_acp$pc2 <- pc2
dnutricion_acp$pc3 <- pc3
dnutricion_acp$pc4 <- pc4
head(dnutricion_acp)## talla edad peso_kg circun_cuello IMC circun_cintura cadera
## 1 155.7 16 71.2 35.7 29.57617 90.0 98.0
## 2 166.5 16 61.0 31.8 22.36471 80.9 100.5
## 3 151.3 16 49.1 30.5 21.62357 72.0 86.0
## 4 151.7 16 54.6 32.6 23.11748 74.4 88.4
## 5 160.3 16 58.0 30.1 22.26020 79.6 97.9
## 6 162.4 16 70.8 33.9 26.12445 86.5 106.1
## ind_cintura_cadera ind_cintura_estatura por_grasa_corporal
## 1 0.9183673 0.5780347 36.44620
## 2 0.8049751 0.4858859 28.79071
## 3 0.8372093 0.4758757 29.86742
## 4 0.8416290 0.4904417 27.86764
## 5 0.8130746 0.4965689 30.27669
## 6 0.8152686 0.5326355 31.43973
## masa_corporal_magra_kg pliegue_cutaneo_BICEPS pliegue_cutaneo_TRICEPS
## 1 45.25030 13 27
## 2 43.43766 5 19
## 3 34.43510 13 18
## 4 39.38427 5 19
## 5 40.43952 10 19
## 6 48.54067 11 25
## pliegue_cutaneo_ESCAPULAR pliegue_cutaneo_SUPRAILIACO target pc1
## 1 32 34 1 -136.9836
## 2 15 22 0 -129.2669
## 3 18 17 0 -119.8487
## 4 15 18 0 -116.4406
## 5 20 19 1 -138.5696
## 6 18 20 0 -164.8307
## pc2 pc3 pc4
## 1 -54.06902 17.476924 5.037509
## 2 68.45323 55.261899 -196.940822
## 3 -125.94676 93.456256 43.697899
## 4 -30.08579 -46.294921 51.826244
## 5 -22.58760 66.041939 24.569935
## 6 -14.61240 -4.977216 -156.154659Con base en la composición de cada Componente se le asignara el nombre.
nutricion_PCA$var$contrib## Dim.1 Dim.2 Dim.3 Dim.4
## talla 0.3226048 16.524676993 1.439082e+01 1.689375e+00
## edad 0.2796518 0.422168389 5.490771e+00 8.851709e+01
## peso_kg 7.4449384 9.365509429 4.904694e+00 1.264192e+00
## circun_cuello 6.4529160 8.328793261 7.968961e-01 4.343894e-01
## IMC 12.0439892 0.379745717 8.475148e-04 1.351386e-03
## circun_cintura 9.6541510 4.732566075 2.627915e+00 5.175865e-01
## cadera 9.8373813 0.004055649 1.199571e+01 7.007767e-03
## ind_cintura_cadera 0.3247730 9.205197166 4.331507e+01 1.198932e+00
## ind_cintura_estatura 10.4519773 0.039270275 1.135198e+01 1.654280e+00
## por_grasa_corporal 7.4559257 10.874813034 6.279622e-01 6.961607e-04
## masa_corporal_magra_kg 0.4446225 24.468044585 2.815034e+00 1.157070e+00
## pliegue_cutaneo_BICEPS 4.1907924 5.256038385 4.617195e-03 2.408725e+00
## pliegue_cutaneo_TRICEPS 8.6087697 5.390017756 1.392738e+00 2.973825e-01
## pliegue_cutaneo_ESCAPULAR 10.0484781 1.187942193 1.498945e-01 7.147162e-03
## pliegue_cutaneo_SUPRAILIACO 9.2311149 3.434562141 1.055823e-01 1.642799e-02
## target 3.2079140 0.386598954 2.946493e-02 8.283484e-01
## Dim.5 Dim.6 Dim.7 Dim.8
## talla 3.03480325 8.701730336 18.115476019 1.120771532
## edad 0.47458391 2.692363330 0.004907823 1.839849966
## peso_kg 0.67540940 0.454799478 0.124565633 0.115660941
## circun_cuello 0.32663244 2.740578632 6.216045097 31.136732036
## IMC 0.33049880 1.805084491 9.398612938 2.662093827
## circun_cintura 1.36183196 0.152621042 0.097124088 17.132446394
## cadera 0.06712492 2.445356895 3.601308196 20.410761289
## ind_cintura_cadera 2.33685368 5.078307444 7.667085101 0.007334212
## ind_cintura_estatura 0.02387400 1.145604266 3.266436939 11.821421561
## por_grasa_corporal 1.00004882 1.121670696 1.177034965 0.242270292
## masa_corporal_magra_kg 0.09323095 0.001403353 1.113255224 1.029787837
## pliegue_cutaneo_BICEPS 0.20712911 69.048258755 10.841130932 1.367823442
## pliegue_cutaneo_TRICEPS 0.93564637 1.114212980 5.718808420 0.695167947
## pliegue_cutaneo_ESCAPULAR 0.46060218 1.664053880 14.263070945 6.819880388
## pliegue_cutaneo_SUPRAILIACO 2.23794629 0.192624849 12.047975806 2.891067186
## target 86.43378393 1.641329572 6.347161874 0.706931151
## Dim.9 Dim.10 Dim.11 Dim.12
## talla 7.401314e-04 1.211787e-03 11.600709275 10.087214023
## edad 8.413849e-04 9.072402e-02 0.000234772 0.160331492
## peso_kg 4.607674e-03 6.790728e-01 20.377501440 0.469031412
## circun_cuello 1.911425e+00 2.189672e-05 29.286317508 0.614301403
## IMC 5.836232e-02 4.645594e-01 4.182635322 24.106148938
## circun_cintura 2.403845e-03 3.778533e-02 2.462274889 0.091117314
## cadera 9.768850e-02 2.522551e+00 6.608019660 1.124971792
## ind_cintura_cadera 9.711545e-02 2.031479e+00 0.405804418 0.627937707
## ind_cintura_estatura 6.179196e-04 1.189400e-01 0.151747637 1.008948513
## por_grasa_corporal 1.290227e-01 6.649131e-01 5.121372204 25.139790453
## masa_corporal_magra_kg 2.931617e-02 7.613684e-02 16.286334105 18.579724716
## pliegue_cutaneo_BICEPS 5.985920e-01 4.317375e-01 0.958567703 3.870838887
## pliegue_cutaneo_TRICEPS 4.040341e-02 6.377523e+01 1.690864281 8.697148048
## pliegue_cutaneo_ESCAPULAR 4.948092e+01 1.423354e+01 0.001644716 1.499456974
## pliegue_cutaneo_SUPRAILIACO 4.726044e+01 1.484135e+01 0.846559496 3.921900409
## target 2.875042e-01 3.074427e-02 0.019412574 0.001137917
## Dim.13 Dim.14 Dim.15 Dim.16
## talla 5.11925617 8.123168e-01 8.385637e+00 9.265290e-02
## edad 0.01578879 6.834138e-03 3.006357e-03 8.554572e-04
## peso_kg 6.26488379 4.699443e+01 8.423676e-01 1.833908e-02
## circun_cuello 11.50207252 8.683207e-03 2.282221e-01 1.597344e-02
## IMC 40.85337902 1.099787e+00 2.605673e+00 7.231173e-03
## circun_cintura 0.50304674 1.232637e-02 1.102967e+01 4.958513e+01
## cadera 0.56072334 1.157809e-02 1.114408e+01 2.956168e+01
## ind_cintura_cadera 0.07190990 3.433779e-04 7.570889e+00 2.006097e+01
## ind_cintura_estatura 0.67526766 6.009161e-02 5.761744e+01 6.121015e-01
## por_grasa_corporal 28.68387188 1.726503e+01 4.856149e-01 9.963007e-03
## masa_corporal_magra_kg 0.21556140 3.363639e+01 5.225904e-02 1.830715e-03
## pliegue_cutaneo_BICEPS 0.78678833 1.611621e-02 1.190074e-02 9.433931e-04
## pliegue_cutaneo_TRICEPS 1.62530351 1.556467e-02 7.655997e-04 1.980016e-03
## pliegue_cutaneo_ESCAPULAR 0.15824606 4.963224e-03 6.966762e-04 1.946271e-02
## pliegue_cutaneo_SUPRAILIACO 2.91251344 4.528096e-02 1.388286e-02 7.664556e-04
## target 0.05138746 1.026998e-02 7.890144e-03 1.012064e-02Guardamos los nuevos componentes. Solo los top 4 seleccionados.
nutricion_PCA$var$contrib## Dim.1 Dim.2 Dim.3 Dim.4
## talla 0.3226048 16.524676993 1.439082e+01 1.689375e+00
## edad 0.2796518 0.422168389 5.490771e+00 8.851709e+01
## peso_kg 7.4449384 9.365509429 4.904694e+00 1.264192e+00
## circun_cuello 6.4529160 8.328793261 7.968961e-01 4.343894e-01
## IMC 12.0439892 0.379745717 8.475148e-04 1.351386e-03
## circun_cintura 9.6541510 4.732566075 2.627915e+00 5.175865e-01
## cadera 9.8373813 0.004055649 1.199571e+01 7.007767e-03
## ind_cintura_cadera 0.3247730 9.205197166 4.331507e+01 1.198932e+00
## ind_cintura_estatura 10.4519773 0.039270275 1.135198e+01 1.654280e+00
## por_grasa_corporal 7.4559257 10.874813034 6.279622e-01 6.961607e-04
## masa_corporal_magra_kg 0.4446225 24.468044585 2.815034e+00 1.157070e+00
## pliegue_cutaneo_BICEPS 4.1907924 5.256038385 4.617195e-03 2.408725e+00
## pliegue_cutaneo_TRICEPS 8.6087697 5.390017756 1.392738e+00 2.973825e-01
## pliegue_cutaneo_ESCAPULAR 10.0484781 1.187942193 1.498945e-01 7.147162e-03
## pliegue_cutaneo_SUPRAILIACO 9.2311149 3.434562141 1.055823e-01 1.642799e-02
## target 3.2079140 0.386598954 2.946493e-02 8.283484e-01
## Dim.5 Dim.6 Dim.7 Dim.8
## talla 3.03480325 8.701730336 18.115476019 1.120771532
## edad 0.47458391 2.692363330 0.004907823 1.839849966
## peso_kg 0.67540940 0.454799478 0.124565633 0.115660941
## circun_cuello 0.32663244 2.740578632 6.216045097 31.136732036
## IMC 0.33049880 1.805084491 9.398612938 2.662093827
## circun_cintura 1.36183196 0.152621042 0.097124088 17.132446394
## cadera 0.06712492 2.445356895 3.601308196 20.410761289
## ind_cintura_cadera 2.33685368 5.078307444 7.667085101 0.007334212
## ind_cintura_estatura 0.02387400 1.145604266 3.266436939 11.821421561
## por_grasa_corporal 1.00004882 1.121670696 1.177034965 0.242270292
## masa_corporal_magra_kg 0.09323095 0.001403353 1.113255224 1.029787837
## pliegue_cutaneo_BICEPS 0.20712911 69.048258755 10.841130932 1.367823442
## pliegue_cutaneo_TRICEPS 0.93564637 1.114212980 5.718808420 0.695167947
## pliegue_cutaneo_ESCAPULAR 0.46060218 1.664053880 14.263070945 6.819880388
## pliegue_cutaneo_SUPRAILIACO 2.23794629 0.192624849 12.047975806 2.891067186
## target 86.43378393 1.641329572 6.347161874 0.706931151
## Dim.9 Dim.10 Dim.11 Dim.12
## talla 7.401314e-04 1.211787e-03 11.600709275 10.087214023
## edad 8.413849e-04 9.072402e-02 0.000234772 0.160331492
## peso_kg 4.607674e-03 6.790728e-01 20.377501440 0.469031412
## circun_cuello 1.911425e+00 2.189672e-05 29.286317508 0.614301403
## IMC 5.836232e-02 4.645594e-01 4.182635322 24.106148938
## circun_cintura 2.403845e-03 3.778533e-02 2.462274889 0.091117314
## cadera 9.768850e-02 2.522551e+00 6.608019660 1.124971792
## ind_cintura_cadera 9.711545e-02 2.031479e+00 0.405804418 0.627937707
## ind_cintura_estatura 6.179196e-04 1.189400e-01 0.151747637 1.008948513
## por_grasa_corporal 1.290227e-01 6.649131e-01 5.121372204 25.139790453
## masa_corporal_magra_kg 2.931617e-02 7.613684e-02 16.286334105 18.579724716
## pliegue_cutaneo_BICEPS 5.985920e-01 4.317375e-01 0.958567703 3.870838887
## pliegue_cutaneo_TRICEPS 4.040341e-02 6.377523e+01 1.690864281 8.697148048
## pliegue_cutaneo_ESCAPULAR 4.948092e+01 1.423354e+01 0.001644716 1.499456974
## pliegue_cutaneo_SUPRAILIACO 4.726044e+01 1.484135e+01 0.846559496 3.921900409
## target 2.875042e-01 3.074427e-02 0.019412574 0.001137917
## Dim.13 Dim.14 Dim.15 Dim.16
## talla 5.11925617 8.123168e-01 8.385637e+00 9.265290e-02
## edad 0.01578879 6.834138e-03 3.006357e-03 8.554572e-04
## peso_kg 6.26488379 4.699443e+01 8.423676e-01 1.833908e-02
## circun_cuello 11.50207252 8.683207e-03 2.282221e-01 1.597344e-02
## IMC 40.85337902 1.099787e+00 2.605673e+00 7.231173e-03
## circun_cintura 0.50304674 1.232637e-02 1.102967e+01 4.958513e+01
## cadera 0.56072334 1.157809e-02 1.114408e+01 2.956168e+01
## ind_cintura_cadera 0.07190990 3.433779e-04 7.570889e+00 2.006097e+01
## ind_cintura_estatura 0.67526766 6.009161e-02 5.761744e+01 6.121015e-01
## por_grasa_corporal 28.68387188 1.726503e+01 4.856149e-01 9.963007e-03
## masa_corporal_magra_kg 0.21556140 3.363639e+01 5.225904e-02 1.830715e-03
## pliegue_cutaneo_BICEPS 0.78678833 1.611621e-02 1.190074e-02 9.433931e-04
## pliegue_cutaneo_TRICEPS 1.62530351 1.556467e-02 7.655997e-04 1.980016e-03
## pliegue_cutaneo_ESCAPULAR 0.15824606 4.963224e-03 6.966762e-04 1.946271e-02
## pliegue_cutaneo_SUPRAILIACO 2.91251344 4.528096e-02 1.388286e-02 7.664556e-04
## target 0.05138746 1.026998e-02 7.890144e-03 1.012064e-02componentes <- nutricion_PCA$ind$coord [, 1:4]
save(componentes, file = "componentes.Rds")
save(dnutricion_acp, file = "dnutricion_acp.Rds")head(dnutricion_acp)## talla edad peso_kg circun_cuello IMC circun_cintura cadera
## 1 155.7 16 71.2 35.7 29.57617 90.0 98.0
## 2 166.5 16 61.0 31.8 22.36471 80.9 100.5
## 3 151.3 16 49.1 30.5 21.62357 72.0 86.0
## 4 151.7 16 54.6 32.6 23.11748 74.4 88.4
## 5 160.3 16 58.0 30.1 22.26020 79.6 97.9
## 6 162.4 16 70.8 33.9 26.12445 86.5 106.1
## ind_cintura_cadera ind_cintura_estatura por_grasa_corporal
## 1 0.9183673 0.5780347 36.44620
## 2 0.8049751 0.4858859 28.79071
## 3 0.8372093 0.4758757 29.86742
## 4 0.8416290 0.4904417 27.86764
## 5 0.8130746 0.4965689 30.27669
## 6 0.8152686 0.5326355 31.43973
## masa_corporal_magra_kg pliegue_cutaneo_BICEPS pliegue_cutaneo_TRICEPS
## 1 45.25030 13 27
## 2 43.43766 5 19
## 3 34.43510 13 18
## 4 39.38427 5 19
## 5 40.43952 10 19
## 6 48.54067 11 25
## pliegue_cutaneo_ESCAPULAR pliegue_cutaneo_SUPRAILIACO target pc1
## 1 32 34 1 -136.9836
## 2 15 22 0 -129.2669
## 3 18 17 0 -119.8487
## 4 15 18 0 -116.4406
## 5 20 19 1 -138.5696
## 6 18 20 0 -164.8307
## pc2 pc3 pc4
## 1 -54.06902 17.476924 5.037509
## 2 68.45323 55.261899 -196.940822
## 3 -125.94676 93.456256 43.697899
## 4 -30.08579 -46.294921 51.826244
## 5 -22.58760 66.041939 24.569935
## 6 -14.61240 -4.977216 -156.154659Fin!!
B. ANÁLISIS DE CLÚSTER
library("easypackages") # instalamos y cargamos los paquetes
paq <- c("tidyverse", "ggplot2", "ggcorrplot", "dplyr", "readxl", "FactoMineR",
"corrplot", "GGally", "factoextra", "Hmisc", "PerformanceAnalytics", "car", "cluster",
"NbClust", "tidyr", "readr")
packages(paq)## Loading required package: tidyverse## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ tibble 3.1.8 ✔ stringr 1.4.1
## ✔ tidyr 1.2.1 ✔ forcats 0.5.2
## ✔ purrr 0.3.5
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ xts::first() masks dplyr::first()
## ✖ dplyr::lag() masks stats::lag()
## ✖ xts::last() masks dplyr::last()
## ✖ dplyr::recode() masks car::recode()
## ✖ purrr::some() masks car::some()
## ✖ Hmisc::src() masks dplyr::src()
## ✖ Hmisc::summarize() masks dplyr::summarize()
## Loading required package: cluster
##
## Loading required package: NbClust
##
## All packages loaded successfullyset.seed(567)1. Observamos la data
se toma el archivo dX1.RDS ya trabajado
dnutricion <- readRDS("dx1.rds") #levantamos
head(dnutricion, 6)## talla edad peso_kg circun_cuello IMC circun_cintura cadera
## 1 155.7 16 71.2 35.7 29.57617 90.0 98.0
## 2 166.5 16 61.0 31.8 22.36471 80.9 100.5
## 3 151.3 16 49.1 30.5 21.62357 72.0 86.0
## 4 151.7 16 54.6 32.6 23.11748 74.4 88.4
## 5 160.3 16 58.0 30.1 22.26020 79.6 97.9
## 6 162.4 16 70.8 33.9 26.12445 86.5 106.1
## ind_cintura_cadera ind_cintura_estatura por_grasa_corporal
## 1 0.9183673 0.5780347 36.44620
## 2 0.8049751 0.4858859 28.79071
## 3 0.8372093 0.4758757 29.86742
## 4 0.8416290 0.4904417 27.86764
## 5 0.8130746 0.4965689 30.27669
## 6 0.8152686 0.5326355 31.43973
## masa_corporal_magra_kg pliegue_cutaneo_BICEPS pliegue_cutaneo_TRICEPS
## 1 45.25030 13 27
## 2 43.43766 5 19
## 3 34.43510 13 18
## 4 39.38427 5 19
## 5 40.43952 10 19
## 6 48.54067 11 25
## pliegue_cutaneo_ESCAPULAR pliegue_cutaneo_SUPRAILIACO target
## 1 32 34 1
## 2 15 22 0
## 3 18 17 0
## 4 15 18 0
## 5 20 19 1
## 6 18 20 0View(dnutricion)str(dnutricion) #data seleccionada para el an?lisis clUster## 'data.frame': 652 obs. of 16 variables:
## $ talla : num 156 166 151 152 160 ...
## $ edad : num 16 16 16 16 16 16 16 16 16 16 ...
## $ peso_kg : num 71.2 61 49.1 54.6 58 70.8 47.4 49.3 91 50.4 ...
## $ circun_cuello : num 35.7 31.8 30.5 32.6 30.1 33.9 30.5 31.2 37.5 30.8 ...
## $ IMC : num 29.6 22.4 21.6 23.1 22.3 ...
## $ circun_cintura : num 90 80.9 72 74.4 79.6 ...
## $ cadera : num 98 100.5 86 88.4 97.9 ...
## $ ind_cintura_cadera : num 0.918 0.805 0.837 0.842 0.813 ...
## $ ind_cintura_estatura : num 0.578 0.486 0.476 0.49 0.497 ...
## $ por_grasa_corporal : num 36.4 28.8 29.9 27.9 30.3 ...
## $ masa_corporal_magra_kg : num 45.3 43.4 34.4 39.4 40.4 ...
## $ pliegue_cutaneo_BICEPS : num 13 5 13 5 10 11 3.5 5.5 25 3 ...
## $ pliegue_cutaneo_TRICEPS : num 27 19 18 19 19 25 7 12 21 7 ...
## $ pliegue_cutaneo_ESCAPULAR : num 32 15 18 15 20 18 6 10.5 25 8.5 ...
## $ pliegue_cutaneo_SUPRAILIACO: num 34 22 17 18 19 20 6 11.5 15 9 ...
## $ target : num 1 0 0 0 1 0 1 0 1 0 ...##2. Viendo que las variables estan en diferentes escalas, vamos a normalizar las puntuaciones:
dnutricion <- scale(dnutricion)
View(dnutricion)
str(dnutricion)## num [1:652, 1:16] -0.42 1.067 -1.026 -0.971 0.213 ...
## - attr(*, "dimnames")=List of 2
## ..$ : NULL
## ..$ : chr [1:16] "talla" "edad" "peso_kg" "circun_cuello" ...
## - attr(*, "scaled:center")= Named num [1:16] 158.8 14.8 57 32.2 22.4 ...
## ..- attr(*, "names")= chr [1:16] "talla" "edad" "peso_kg" "circun_cuello" ...
## - attr(*, "scaled:scale")= Named num [1:16] 7.26 1.05 8.48 2.15 3.03 ...
## ..- attr(*, "names")= chr [1:16] "talla" "edad" "peso_kg" "circun_cuello" ...3. Calcular las distancias con el método euclidean
Distancias <- get_dist(dnutricion, method = "euclidean")
fviz_dist(Distancias, gradient = list(low = "blue", mid = "white", high = "red"))
Nota Explicativa: Como son bastantes casos, el gráfico no se aprecia mucho
4.Determinar el número de clústers.
Vamos a estimar el número de clusters idóneo: Elbow
fviz_nbclust(dnutricion, kmeans, method = "wss")
Vamos a estimar el número de clusters idoneo: Método silhouette
fviz_nbclust(dnutricion, kmeans, method = "silhouette")
Vamos a estimar el número de clusters idoneo: Método gap_stat
fviz_nbclust(dnutricion, kmeans, method = "gap_stat")
5. Realizaremos una clasificación Jerárquica para visualizar posible número de clústers
CJerarquico <- hcut(dnutricion, k = 5, stand = TRUE) #k = 2 a m?s
fviz_dend(CJerarquico, rect = TRUE, cex = 0.5,
k_colors = c("red","#2E9FDF","green","black", "blue"))## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.
6. Calculamos los k=5 clusters; podemos probar igual con 3 y 4 clusters.
kmeans5 <- kmeans(dnutricion, centers = 5, nstart = 25)
kmeans5## K-means clustering with 5 clusters of sizes 168, 134, 159, 80, 111
##
## Cluster means:
## talla edad peso_kg circun_cuello IMC
## 1 -0.5604446068 0.08311568 0.0008906537 0.1216919 0.42141257
## 2 0.4641404644 -0.15153885 -0.6488183365 -0.3590193 -0.98376085
## 3 -0.5415444566 -0.14622655 -0.7741914073 -1.0558198 -0.55352476
## 4 -0.0009028845 0.22465199 1.6122170426 1.4585600 1.82767351
## 5 1.0643033430 0.10469040 0.7289288073 0.7104044 0.02543421
## circun_cintura cadera ind_cintura_cadera ind_cintura_estatura
## 1 0.2426519 0.42967992 -0.1501702 0.4993421
## 2 -0.6892971 -1.06624098 0.3298816 -0.8583001
## 3 -0.8110643 -0.30999299 -0.8082744 -0.5390979
## 4 1.7792635 1.59734158 0.5255434 1.6957858
## 5 0.3443103 -0.07034573 0.6080777 -0.1695816
## por_grasa_corporal masa_corporal_magra_kg pliegue_cutaneo_BICEPS
## 1 0.8329118 -0.5107833 0.5930933
## 2 -1.4172942 0.2504436 -0.8595099
## 3 0.3835601 -0.9303435 0.1453214
## 4 0.9883859 0.6904323 0.7653180
## 5 -0.8114297 1.3057854 -0.6197919
## pliegue_cutaneo_TRICEPS pliegue_cutaneo_ESCAPULAR pliegue_cutaneo_SUPRAILIACO
## 1 0.67028610 0.5481245 0.69249563
## 2 -1.21738101 -1.0908120 -1.18809083
## 3 0.07147844 -0.2848571 -0.05754652
## 4 1.27306177 1.5639078 1.30493932
## 5 -0.56476597 -0.2318600 -0.47189499
## target
## 1 0.08486075
## 2 -0.28821010
## 3 -0.41495635
## 4 1.25000720
## 5 -0.08701773
##
## Clustering vector:
## [1] 4 1 3 1 1 4 2 2 4 2 2 2 2 2 1 4 2 2 5 4 1 1 1 3 1 2 4 2 2 2 2 1 2 1 4 2 2
## [38] 2 1 4 4 2 2 1 3 1 2 3 3 5 3 3 4 1 3 2 1 2 2 1 5 1 4 5 1 5 3 3 1 2 2 2 4 5
## [75] 4 3 3 5 5 1 1 4 4 3 1 1 3 3 2 3 5 3 4 1 1 3 5 3 1 1 4 3 4 5 1 1 1 3 1 2 1
## [112] 5 3 3 1 5 2 4 5 1 5 3 3 5 1 3 2 5 1 4 1 3 1 3 5 4 4 4 1 4 5 4 4 5 4 3 1 3
## [149] 5 4 1 1 5 1 5 1 5 5 5 3 3 2 1 5 3 2 2 3 1 1 1 2 2 1 1 3 2 2 1 2 3 5 3 3 3
## [186] 3 3 4 3 1 5 2 3 1 2 3 3 1 2 3 2 1 2 2 1 2 2 1 2 2 3 1 4 1 1 3 1 2 4 3 1 3
## [223] 2 2 2 1 3 2 3 2 1 3 1 3 3 1 3 2 1 2 1 3 3 4 2 1 1 2 2 1 1 2 4 4 1 2 2 2 5
## [260] 3 1 4 3 3 1 2 3 3 4 1 2 3 2 4 3 3 3 4 1 1 2 1 2 1 1 1 3 2 2 5 3 1 1 4 4 5
## [297] 1 2 2 2 2 5 1 2 2 4 1 1 5 3 3 4 5 5 3 5 4 5 3 1 1 5 3 1 1 5 5 5 1 2 3 2 3
## [334] 3 5 5 5 1 1 1 4 5 5 3 3 5 3 5 5 1 5 3 1 5 4 2 5 5 5 1 2 5 4 5 3 5 5 3 3 1
## [371] 1 5 5 1 3 3 5 1 1 3 5 5 1 1 5 3 4 1 5 3 5 5 1 2 2 2 3 2 1 2 1 4 4 5 4 3 2
## [408] 3 3 3 2 3 2 1 2 1 3 1 3 3 2 1 2 5 3 3 3 1 1 1 1 3 4 4 2 1 2 3 1 4 2 2 1 2
## [445] 1 2 3 1 2 2 2 1 2 3 2 1 3 3 1 1 2 3 5 2 3 2 3 2 2 3 2 2 1 3 1 5 1 3 4 1 2
## [482] 2 2 1 2 4 2 2 3 3 3 2 5 3 3 2 2 2 3 5 3 3 4 3 1 2 1 2 1 3 1 2 1 4 3 3 3 5
## [519] 2 3 4 1 4 1 3 4 1 4 3 5 4 5 1 5 5 2 5 3 3 1 3 3 5 1 5 1 1 4 2 3 5 5 2 4 5
## [556] 1 3 2 4 3 5 5 2 1 3 2 4 3 5 5 3 5 3 3 1 3 2 3 2 3 5 4 3 3 3 5 1 1 3 5 1 3
## [593] 3 1 5 4 3 5 5 4 5 1 5 5 5 1 3 1 5 1 3 5 2 3 4 1 4 1 4 5 1 1 3 3 3 4 5 5 4
## [630] 1 4 2 5 4 3 1 5 4 1 3 5 4 5 1 4 5 1 5 1 1 4 1
##
## Within cluster sum of squares by cluster:
## [1] 1313.5942 663.9406 1001.9099 1005.5930 703.6762
## (between_SS / total_SS = 55.0 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"head(dnutricion)## talla edad peso_kg circun_cuello IMC circun_cintura
## [1,] -0.4200366 1.175776 1.6787048 1.6456906 2.35800308 2.21056509
## [2,] 1.0671567 1.175776 0.4757331 -0.1674998 -0.01953713 0.90119236
## [3,] -1.0259302 1.175776 -0.9277339 -0.7718965 -0.26388277 -0.37940295
## [4,] -0.9708490 1.175776 -0.2790726 0.2044367 0.22864352 -0.03407388
## [5,] 0.2133975 1.175776 0.1219179 -0.9578648 -0.05399327 0.71413911
## [6,] 0.5025740 1.175776 1.6315295 0.8088335 1.22000923 1.70696019
## cadera ind_cintura_cadera ind_cintura_estatura por_grasa_corporal
## [1,] 1.1265659 1.6138783 2.3317044 1.6432643
## [2,] 1.4732343 -0.4804632 0.3279832 0.6704914
## [3,] -0.5374423 0.1148984 0.1103186 0.8073068
## [4,] -0.2046407 0.1965290 0.4270459 0.5531976
## [5,] 1.1126992 -0.3308674 0.5602798 0.8593121
## [6,] 2.2497715 -0.2903436 1.3445253 1.0070978
## masa_corporal_magra_kg pliegue_cutaneo_BICEPS pliegue_cutaneo_TRICEPS
## [1,] 0.27923455 0.6787299 1.9984715
## [2,] 0.01362736 -0.7422034 0.5873401
## [3,] -1.30552435 0.6787299 0.4109487
## [4,] -0.58031924 -0.7422034 0.5873401
## [5,] -0.42569245 0.1458799 0.5873401
## [6,] 0.76137454 0.3234966 1.6456886
## pliegue_cutaneo_ESCAPULAR pliegue_cutaneo_SUPRAILIACO target
## [1,] 3.3344275 3.2552814 2.0826904
## [2,] 0.1153007 1.2355097 -0.4794118
## [3,] 0.6833819 0.3939381 -0.4794118
## [4,] 0.1153007 0.5622524 -0.4794118
## [5,] 1.0621027 0.7305667 2.0826904
## [6,] 0.6833819 0.8988810 -0.4794118estructura k-means
str(kmeans5)## List of 9
## $ cluster : int [1:652] 4 1 3 1 1 4 2 2 4 2 ...
## $ centers : num [1:5, 1:16] -0.560445 0.46414 -0.541544 -0.000903 1.064303 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:5] "1" "2" "3" "4" ...
## .. ..$ : chr [1:16] "talla" "edad" "peso_kg" "circun_cuello" ...
## $ totss : num 10416
## $ withinss : num [1:5] 1314 664 1002 1006 704
## $ tot.withinss: num 4689
## $ betweenss : num 5727
## $ size : int [1:5] 168 134 159 80 111
## $ iter : int 4
## $ ifault : int 0
## - attr(*, "class")= chr "kmeans"Centroides de los clusters:
kmeans5$centers## talla edad peso_kg circun_cuello IMC
## 1 -0.5604446068 0.08311568 0.0008906537 0.1216919 0.42141257
## 2 0.4641404644 -0.15153885 -0.6488183365 -0.3590193 -0.98376085
## 3 -0.5415444566 -0.14622655 -0.7741914073 -1.0558198 -0.55352476
## 4 -0.0009028845 0.22465199 1.6122170426 1.4585600 1.82767351
## 5 1.0643033430 0.10469040 0.7289288073 0.7104044 0.02543421
## circun_cintura cadera ind_cintura_cadera ind_cintura_estatura
## 1 0.2426519 0.42967992 -0.1501702 0.4993421
## 2 -0.6892971 -1.06624098 0.3298816 -0.8583001
## 3 -0.8110643 -0.30999299 -0.8082744 -0.5390979
## 4 1.7792635 1.59734158 0.5255434 1.6957858
## 5 0.3443103 -0.07034573 0.6080777 -0.1695816
## por_grasa_corporal masa_corporal_magra_kg pliegue_cutaneo_BICEPS
## 1 0.8329118 -0.5107833 0.5930933
## 2 -1.4172942 0.2504436 -0.8595099
## 3 0.3835601 -0.9303435 0.1453214
## 4 0.9883859 0.6904323 0.7653180
## 5 -0.8114297 1.3057854 -0.6197919
## pliegue_cutaneo_TRICEPS pliegue_cutaneo_ESCAPULAR pliegue_cutaneo_SUPRAILIACO
## 1 0.67028610 0.5481245 0.69249563
## 2 -1.21738101 -1.0908120 -1.18809083
## 3 0.07147844 -0.2848571 -0.05754652
## 4 1.27306177 1.5639078 1.30493932
## 5 -0.56476597 -0.2318600 -0.47189499
## target
## 1 0.08486075
## 2 -0.28821010
## 3 -0.41495635
## 4 1.25000720
## 5 -0.08701773Tamaño de los clusters:
kmeans5$size## [1] 168 134 159 80 111Graficar los clusters
Gráfico de los cluster’s
fviz_cluster(list(data = dnutricion, cluster = kmeans5$cluster))
2do tipo de gráfico
fviz_cluster(list(data = dnutricion, cluster = kmeans5$cluster), ellipse.type = "euclid",repel = TRUE,star.plot = TRUE)## Warning: ggrepel: 598 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps
3er tipo de grafico
fviz_cluster(list(data = dnutricion, cluster = kmeans5$cluster),ellipse.type = "norm")
4to tipo de grafico
fviz_cluster(list(data = dnutricion, cluster = kmeans5$cluster), ellipse.type = "norm",palette = "Set2", ggtheme = theme_minimal())
Guardamos el clúster en la base de datos originales:
cluster <- data.frame(kmeans5$cluster)
str(cluster)## 'data.frame': 652 obs. of 1 variable:
## $ kmeans5.cluster: int 4 1 3 1 1 4 2 2 4 2 ...str(dnutricion)## num [1:652, 1:16] -0.42 1.067 -1.026 -0.971 0.213 ...
## - attr(*, "dimnames")=List of 2
## ..$ : NULL
## ..$ : chr [1:16] "talla" "edad" "peso_kg" "circun_cuello" ...
## - attr(*, "scaled:center")= Named num [1:16] 158.8 14.8 57 32.2 22.4 ...
## ..- attr(*, "names")= chr [1:16] "talla" "edad" "peso_kg" "circun_cuello" ...
## - attr(*, "scaled:scale")= Named num [1:16] 7.26 1.05 8.48 2.15 3.03 ...
## ..- attr(*, "names")= chr [1:16] "talla" "edad" "peso_kg" "circun_cuello" ...data_nutricion_c <- dnutricion
data_nutricion_c$cluster <- as.factor(cluster$kmeans5.cluster)## Warning in data_nutricion_c$cluster <- as.factor(cluster$kmeans5.cluster):
## Coercing LHS to a listhead(data_nutricion_c)## [[1]]
## [1] -0.4200366
##
## [[2]]
## [1] 1.067157
##
## [[3]]
## [1] -1.02593
##
## [[4]]
## [1] -0.970849
##
## [[5]]
## [1] 0.2133975
##
## [[6]]
## [1] 0.502574saveRDS(data_nutricion_c, file="data_nutricion_c.rds") # guardamosFin!!
————- Regresión Logística ————-
variable dependiente: Target 0: No tiene diabetes 1: Si tiene diabetes
Variable Independiente: IMC
- Cargamos los datos para el modelo
dnutricion <- dnutricion_acp
str(dnutricion)## 'data.frame': 652 obs. of 20 variables:
## $ talla : num 156 166 151 152 160 ...
## $ edad : num 16 16 16 16 16 16 16 16 16 16 ...
## $ peso_kg : num 71.2 61 49.1 54.6 58 70.8 47.4 49.3 91 50.4 ...
## $ circun_cuello : num 35.7 31.8 30.5 32.6 30.1 33.9 30.5 31.2 37.5 30.8 ...
## $ IMC : num 29.6 22.4 21.6 23.1 22.3 ...
## $ circun_cintura : num 90 80.9 72 74.4 79.6 ...
## $ cadera : num 98 100.5 86 88.4 97.9 ...
## $ ind_cintura_cadera : num 0.918 0.805 0.837 0.842 0.813 ...
## $ ind_cintura_estatura : num 0.578 0.486 0.476 0.49 0.497 ...
## $ por_grasa_corporal : num 36.4 28.8 29.9 27.9 30.3 ...
## $ masa_corporal_magra_kg : num 45.3 43.4 34.4 39.4 40.4 ...
## $ pliegue_cutaneo_BICEPS : num 13 5 13 5 10 11 3.5 5.5 25 3 ...
## $ pliegue_cutaneo_TRICEPS : num 27 19 18 19 19 25 7 12 21 7 ...
## $ pliegue_cutaneo_ESCAPULAR : num 32 15 18 15 20 18 6 10.5 25 8.5 ...
## $ pliegue_cutaneo_SUPRAILIACO: num 34 22 17 18 19 20 6 11.5 15 9 ...
## $ target : num 1 0 0 0 1 0 1 0 1 0 ...
## $ pc1 : num -137 -129 -120 -116 -139 ...
## $ pc2 : num -54.1 68.5 -125.9 -30.1 -22.6 ...
## $ pc3 : num 17.5 55.3 93.5 -46.3 66 ...
## $ pc4 : num 5.04 -196.94 43.7 51.83 24.57 ...#head(dnutricion)Observamos a las variables independientes con la variable dependiente.
t1 <- table(dnutricion$IMC, dnutricion$target)
print(summary(t1))## Number of cases in table: 652
## Number of factors: 2
## Test for independence of all factors:
## Chisq = 652, df = 646, p-value = 0.4266
## Chi-squared approximation may be incorrectprint("--------------------------------------------")## [1] "--------------------------------------------"print("Variable Independiente * Variable dependiente:")## [1] "Variable Independiente * Variable dependiente:"print(prop.table(t1, 1)*100)##
## 0 1
## 14.5378861653136 100 0
## 15.7611527668217 100 0
## 16.0724841794997 100 0
## 16.7431812044288 100 0
## 16.7531004171216 100 0
## 16.8601854864754 100 0
## 16.9663825268882 100 0
## 17.0169055221405 100 0
## 17.0768135208091 100 0
## 17.1070388885396 100 0
## 17.2606532873644 100 0
## 17.2873552184 100 0
## 17.2888161808447 100 0
## 17.292186450369 0 100
## 17.3186561009717 0 100
## 17.3252640322772 0 100
## 17.4687745654642 0 100
## 17.5335711667977 0 100
## 17.5438596491228 100 0
## 17.580843912473 100 0
## 17.5939655086626 100 0
## 17.6445578231293 100 0
## 17.6692965154504 100 0
## 17.7037917822698 100 0
## 17.7788587323887 100 0
## 17.8015494697302 100 0
## 17.8125572894749 100 0
## 17.8834720570749 100 0
## 17.9721620008169 100 0
## 18.1568985558093 100 0
## 18.2223421859749 100 0
## 18.2786209384421 100 0
## 18.2849795160305 100 0
## 18.3141489656264 100 0
## 18.3262885722559 100 0
## 18.412345796604 100 0
## 18.4331081069414 100 0
## 18.4365781710914 100 0
## 18.4514224369297 100 0
## 18.5167031554641 100 0
## 18.5210799444683 100 0
## 18.5740924188567 100 0
## 18.6077470526804 100 0
## 18.6085514538225 100 0
## 18.6167634185391 100 0
## 18.6307350671836 100 0
## 18.6312738137661 100 0
## 18.6334322300588 100 0
## 18.6562943239269 100 0
## 18.692033293698 100 0
## 18.7125142458011 100 0
## 18.7150617134417 100 0
## 18.730314624778 100 0
## 18.7574962349737 100 0
## 18.7701766315488 100 0
## 18.8054761546562 100 0
## 18.8205474609227 100 0
## 18.8648626719137 100 0
## 18.8717753190233 100 0
## 18.8753297249934 100 0
## 18.875536785548 100 0
## 18.9111173866933 100 0
## 18.9262642013812 100 0
## 18.932195489261 100 0
## 18.9783341552702 100 0
## 18.9790313467687 100 0
## 18.9807491994908 100 0
## 19.0311418685121 100 0
## 19.0521120627087 100 0
## 19.0666666666667 100 0
## 19.1014403965442 100 0
## 19.1190646730274 100 0
## 19.1570881226054 100 0
## 19.1680799959131 100 0
## 19.1765338855452 100 0
## 19.1887436170117 100 0
## 19.216312706265 100 0
## 19.2163782670153 100 0
## 19.2607340720222 100 0
## 19.2995784726988 100 0
## 19.3118569741946 100 0
## 19.3132154006243 100 0
## 19.3161786589135 100 0
## 19.3265887185232 100 0
## 19.3771626297578 100 0
## 19.3789560183037 100 0
## 19.379836884289 100 0
## 19.3806930785918 100 0
## 19.4215139528574 100 0
## 19.4247606869483 100 0
## 19.4385070306434 100 0
## 19.4423011064309 100 0
## 19.4650905629742 100 0
## 19.4789383978573 100 0
## 19.4951779001748 100 0
## 19.5092211553117 100 0
## 19.5480411437396 100 0
## 19.5612718784644 100 0
## 19.5685525533047 100 0
## 19.5694413504616 100 0
## 19.5716812826979 100 0
## 19.5719004792729 100 0
## 19.580169830561 100 0
## 19.5812212198193 100 0
## 19.585753225984 100 0
## 19.5918367346939 100 0
## 19.5977124124784 100 0
## 19.5992882901922 100 0
## 19.6383733815876 100 0
## 19.645129056844 100 0
## 19.6569832735651 100 0
## 19.6913476134255 100 0
## 19.7066251181474 100 0
## 19.7427984218978 100 0
## 19.7537141276846 100 0
## 19.7985288849693 100 0
## 19.8053417836125 100 0
## 19.8276705227236 100 0
## 19.8290362620309 100 0
## 19.8412067972726 100 0
## 19.8525432497581 100 0
## 19.8694198636704 100 0
## 19.8738418294686 100 0
## 19.8969959827575 100 0
## 19.9003093020351 100 0
## 19.9040664208749 100 0
## 19.9070341505171 100 0
## 19.9246700486889 100 0
## 19.9286139202855 100 0
## 19.9336235150588 100 0
## 19.9432125473229 100 0
## 19.944135536586 100 0
## 19.9516259070142 100 0
## 19.9529987162241 100 0
## 19.9534336741629 100 0
## 19.9580529513849 100 0
## 19.985912083107 100 0
## 19.9985587245609 100 0
## 20.0029744199881 100 0
## 20.02582339841 100 0
## 20.0284552423369 100 0
## 20.0287067344342 100 0
## 20.0326762506055 100 0
## 20.0402309616816 100 0
## 20.0522770751408 100 0
## 20.0710059171598 100 0
## 20.0755857898715 100 0
## 20.0923592149175 100 0
## 20.1174861189346 100 0
## 20.1347797501644 100 0
## 20.1406235271939 100 0
## 20.1529787610405 100 0
## 20.1846713935497 100 0
## 20.1977712343676 100 0
## 20.2121664992528 100 0
## 20.2291299471239 100 0
## 20.23950216667 100 0
## 20.248352082577 100 0
## 20.2589827316483 100 0
## 20.2733719396259 100 0
## 20.2741086028584 100 0
## 20.2751358377989 100 0
## 20.275478150936 100 0
## 20.279031751556 100 0
## 20.3160936029119 100 0
## 20.3209039908792 100 0
## 20.3733794467385 100 0
## 20.37862581039 100 0
## 20.4410774897554 100 0
## 20.4589614118462 100 0
## 20.4728337690893 100 0
## 20.4915521704026 100 0
## 20.5072199487802 100 0
## 20.5202516260718 100 0
## 20.5254203530068 100 0
## 20.5346601450498 100 0
## 20.5380282585114 100 0
## 20.5502653468328 100 0
## 20.554243066928 100 0
## 20.5630580323455 100 0
## 20.5917839701235 100 0
## 20.5967958646376 100 0
## 20.6117946660721 0 100
## 20.6161750708041 0 100
## 20.6239800096843 0 100
## 20.6378804653963 0 100
## 20.6508054400792 0 100
## 20.6666666666667 100 0
## 20.6669197016487 100 0
## 20.6729679490986 100 0
## 20.6854641331435 100 0
## 20.6974616347569 100 0
## 20.7227751234989 100 0
## 20.7327429817671 100 0
## 20.7677715592239 100 0
## 20.7697937152233 100 0
## 20.7882639264467 100 0
## 20.8055833332227 100 0
## 20.8086681798261 100 0
## 20.8189243199186 100 0
## 20.822913370556 100 0
## 20.8284023668639 100 0
## 20.8303091885615 100 0
## 20.8437791263129 100 0
## 20.8438148976006 100 0
## 20.8532434652851 100 0
## 20.8536783854167 100 0
## 20.8718157436106 100 0
## 20.8819995058512 100 0
## 20.8839115566346 100 0
## 20.911352640702 100 0
## 20.9129301230296 100 0
## 20.913693271607 100 0
## 20.9230588351773 100 0
## 20.9326168368524 100 0
## 20.9330052817916 100 0
## 20.9380151788758 100 0
## 20.9420118343195 100 0
## 20.9571711629325 100 0
## 20.963715331213 100 0
## 20.9858878321129 100 0
## 20.9900454934462 100 0
## 20.9936254423742 100 0
## 21.0036882476563 100 0
## 21.0040954426097 100 0
## 21.029380892836 100 0
## 21.0299530062981 100 0
## 21.0349651185729 100 0
## 21.0517082584097 100 0
## 21.0613943808533 100 0
## 21.0771952275208 100 0
## 21.0824503007587 100 0
## 21.0868426469678 100 0
## 21.0907841084847 100 0
## 21.1075853625931 100 0
## 21.1147114595215 100 0
## 21.1172179368667 100 0
## 21.1243316243263 100 0
## 21.1254780549991 100 0
## 21.136836628512 100 0
## 21.1427215019542 100 0
## 21.1671445437679 100 0
## 21.176601408939 100 0
## 21.2016929710059 100 0
## 21.2060567373439 100 0
## 21.2146316508877 100 0
## 21.2191358024691 100 0
## 21.2263856459689 100 0
## 21.2327408149661 100 0
## 21.2445267390322 100 0
## 21.2683250419606 100 0
## 21.3189452126752 100 0
## 21.3406795224977 0 100
## 21.3581143902124 0 100
## 21.3672516096452 0 100
## 21.3748209858742 0 100
## 21.3887885253836 0 100
## 21.4135984950282 100 0
## 21.4180501164853 100 0
## 21.4343195266272 100 0
## 21.44969920344 100 0
## 21.4550904534176 100 0
## 21.456894631321 100 0
## 21.4774388697352 100 0
## 21.4785807523437 100 0
## 21.4841792241639 100 0
## 21.484375 100 0
## 21.5177691688485 100 0
## 21.5248197296348 100 0
## 21.5268329554044 100 0
## 21.5355417052464 100 0
## 21.5510204081633 100 0
## 21.5601271469261 100 0
## 21.5719751309007 100 0
## 21.5748913685294 100 0
## 21.5848337433132 100 0
## 21.5903987884018 100 0
## 21.5945583327548 100 0
## 21.6162198136765 100 0
## 21.6235673294545 100 0
## 21.6860154115283 100 0
## 21.7129211393347 100 0
## 21.7148713953885 0 100
## 21.723970979304 0 100
## 21.7318208960595 0 100
## 21.7346084303612 0 100
## 21.7579013733176 0 100
## 21.7696544281935 100 0
## 21.7731488515839 100 0
## 21.7764801999231 100 0
## 21.7835466618593 100 0
## 21.7843566534871 100 0
## 21.8314372696683 100 0
## 21.8355773311215 100 0
## 21.8427197648977 100 0
## 21.8546990334759 100 0
## 21.8593798949815 100 0
## 21.866215090902 100 0
## 21.8716659045877 100 0
## 21.8989155377465 100 0
## 21.9158563538106 100 0
## 21.9238498280298 100 0
## 21.9250946076745 100 0
## 21.9252713667583 100 0
## 21.9494500618486 100 0
## 21.9543964348202 100 0
## 21.9694721696738 100 0
## 21.9718364534506 100 0
## 21.9872042388163 100 0
## 22.0119457481905 100 0
## 22.0228710921891 100 0
## 22.023870592661 100 0
## 22.0317256849864 100 0
## 22.0375108715583 100 0
## 22.0477906276475 100 0
## 22.0673881918998 100 0
## 22.07684544406 100 0
## 22.0855242607247 100 0
## 22.0940998232472 100 0
## 22.1140373519015 100 0
## 22.1268215799487 100 0
## 22.1325625736727 100 0
## 22.1647522481951 100 0
## 22.1718316956412 100 0
## 22.1770616602958 100 0
## 22.1854912764004 100 0
## 22.1897135304279 100 0
## 22.190577904355 100 0
## 22.1920091224069 100 0
## 22.1937514501599 100 0
## 22.194564741334 100 0
## 22.2190976616136 100 0
## 22.2212795798894 100 0
## 22.2305581626126 100 0
## 22.2548063320524 100 0
## 22.2575645368201 100 0
## 22.2583339051326 100 0
## 22.2595963593194 100 0
## 22.2601960064741 0 100
## 22.2706985149825 0 100
## 22.275137665531 0 100
## 22.2766218867199 0 100
## 22.2913233108161 0 100
## 22.2925248167689 100 0
## 22.2934831455401 100 0
## 22.2957065980907 100 0
## 22.3209175614111 100 0
## 22.3283179012346 100 0
## 22.3322753073273 100 0
## 22.3408890338723 100 0
## 22.341366205947 100 0
## 22.3498128203176 100 0
## 22.3647070493917 100 0
## 22.3648750174303 100 0
## 22.3907063232658 100 0
## 22.4087258220246 100 0
## 22.4153984041211 100 0
## 22.4285795711785 100 0
## 22.4438501657336 100 0
## 22.4535628431103 100 0
## 22.4712087637714 100 0
## 22.4755568177208 100 0
## 22.4838250691294 100 0
## 22.5 100 0
## 22.5180108057629 100 0
## 22.5215080401784 100 0
## 22.5563556448063 100 0
## 22.5834654926952 100 0
## 22.5927605136751 100 0
## 22.6082886464497 100 0
## 22.6283742774 100 0
## 22.6318993047242 100 0
## 22.6466801286156 100 0
## 22.6602292561933 100 0
## 22.6905074376733 100 0
## 22.6906001261158 100 0
## 22.6929281356612 100 0
## 22.7300972651932 100 0
## 22.7464185364954 100 0
## 22.7694383538539 100 0
## 22.7769679300292 100 0
## 22.7819490170698 100 0
## 22.7839689952409 100 0
## 22.7871920265506 100 0
## 22.798576520506 100 0
## 22.8060172799439 100 0
## 22.8286951625149 100 0
## 22.8407260510189 100 0
## 22.8457980685764 100 0
## 22.8498750054822 0 100
## 22.8550970862149 0 100
## 22.8618091873188 0 100
## 22.885918507721 0 100
## 22.88818359375 0 100
## 22.888700489452 100 0
## 22.8909939269563 100 0
## 22.9002094043816 100 0
## 22.9070216049383 100 0
## 22.9197044824983 100 0
## 22.9345046147003 100 0
## 22.9411343986117 100 0
## 22.9498077953597 100 0
## 22.9749975743947 100 0
## 22.9821658393087 100 0
## 22.9932733404267 100 0
## 22.9953199558123 100 0
## 23.0134269948287 100 0
## 23.0156287404672 100 0
## 23.0183925422021 100 0
## 23.0214545103485 100 0
## 23.028302410893 100 0
## 23.047418918305 100 0
## 23.0505361836968 100 0
## 23.0645977399224 100 0
## 23.0732254446403 100 0
## 23.0747024345642 100 0
## 23.0785255341079 100 0
## 23.0933596318212 100 0
## 23.1093509171269 100 0
## 23.1125163521053 100 0
## 23.1130365915864 100 0
## 23.1174789433226 100 0
## 23.1320730761906 100 0
## 23.141498292317 100 0
## 23.1439927244782 100 0
## 23.1571638556338 0 100
## 23.160802074989 0 100
## 23.1677433726888 0 100
## 23.1796422272613 0 100
## 23.1915959945362 0 100
## 23.2052832340594 100 0
## 23.2208200813926 100 0
## 23.2393838557821 100 0
## 23.2421962974641 100 0
## 23.2445945353274 100 0
## 23.2528799215846 100 0
## 23.2726678847391 100 0
## 23.294749029623 100 0
## 23.3009056030656 100 0
## 23.3289098472737 100 0
## 23.3294694279899 100 0
## 23.3752127564275 100 0
## 23.3798295577496 0 100
## 23.3951556104482 0 100
## 23.396506544677 0 100
## 23.4001856802497 0 100
## 23.4235574063058 0 100
## 23.4425671179193 100 0
## 23.4510761804257 100 0
## 23.4527839539558 100 0
## 23.4763481652949 100 0
## 23.494818546697 100 0
## 23.5024238227147 100 0
## 23.5124362225168 100 0
## 23.5144250774187 100 0
## 23.5215284628681 100 0
## 23.5259797394262 100 0
## 23.5283947355115 100 0
## 23.5431875957089 100 0
## 23.5453648915187 100 0
## 23.5457063711911 100 0
## 23.5500066058925 100 0
## 23.5822662906412 100 0
## 23.5846738927487 100 0
## 23.589207663201 100 0
## 23.6127413545076 100 0
## 23.6248021422821 100 0
## 23.6252734253673 100 0
## 23.6373675573577 100 0
## 23.6556374815089 100 0
## 23.6943024105186 100 0
## 23.7032396167802 100 0
## 23.7044569532215 100 0
## 23.7109375 100 0
## 23.7115237586536 100 0
## 23.7332384003797 0 100
## 23.7374284353622 0 100
## 23.7621568295676 0 100
## 23.7775583001512 0 100
## 23.7779366432792 0 100
## 23.8118159116899 100 0
## 23.8330046022354 100 0
## 23.8498002579228 100 0
## 23.870924976642 100 0
## 23.9048748354285 100 0
## 23.9118242092823 100 0
## 23.9219300776056 100 0
## 23.9318928453682 100 0
## 23.9843337828654 100 0
## 23.9850881280667 100 0
## 23.9884733093856 100 0
## 24 100 0
## 24.0273442016418 100 0
## 24.0417533923751 100 0
## 24.0417580166678 100 0
## 24.0435597134508 0 100
## 24.0555911094166 0 100
## 24.0691062604499 0 100
## 24.0955204425291 0 100
## 24.098697351735 0 100
## 24.1092507439455 0 100
## 24.1147252042942 0 100
## 24.1609040310339 0 100
## 24.2045980091718 0 100
## 24.276388958749 0 100
## 24.2764123602695 100 0
## 24.2792795928739 100 0
## 24.3019689241477 100 0
## 24.3068905121962 100 0
## 24.3194025548313 100 0
## 24.3247922437673 100 0
## 24.3301651111793 100 0
## 24.3868050580283 100 0
## 24.3890148652053 100 0
## 24.4125953969112 100 0
## 24.4351866688031 100 0
## 24.443509273148 100 0
## 24.4656004859606 100 0
## 24.4713549637792 0 100
## 24.4887530586374 0 100
## 24.4951038906843 0 100
## 24.5022221661069 0 100
## 24.5164743105359 0 100
## 24.5197096189975 100 0
## 24.5284808367155 100 0
## 24.563202187193 100 0
## 24.563901744393 100 0
## 24.5811968106526 100 0
## 24.5975115636989 100 0
## 24.598648073676 100 0
## 24.6272342825971 100 0
## 24.7093854556893 100 0
## 24.7357633378862 0 100
## 24.7678018575851 0 100
## 24.7872924064261 0 100
## 24.8286801610673 0 100
## 24.9041314228001 0 100
## 24.9242998571304 100 0
## 24.9619933520575 100 0
## 24.9680097375238 100 0
## 24.9926027641244 100 0
## 25.0545012459 100 0
## 25.1446017708462 100 0
## 25.1731197643912 100 0
## 25.2232528262211 100 0
## 25.2418752957728 100 0
## 25.2818106343451 100 0
## 25.283640970718 100 0
## 25.3169494267751 100 0
## 25.3321372121833 100 0
## 25.3415818291024 100 0
## 25.3902185223725 100 0
## 25.4193396691037 100 0
## 25.4766600920447 100 0
## 25.4952897570427 100 0
## 25.5084026407682 100 0
## 25.5893711736323 100 0
## 25.6102860140763 100 0
## 25.6160511367867 100 0
## 25.68 100 0
## 25.6866963848592 100 0
## 25.7553260378988 0 100
## 25.7879704613595 0 100
## 25.8213230026182 0 100
## 25.8515997931872 0 100
## 25.872412243389 0 100
## 25.887573964497 100 0
## 25.9034141818025 100 0
## 25.9447403415207 100 0
## 25.9471621425461 100 0
## 26.0161911532218 100 0
## 26.0415669364011 0 100
## 26.1048894457932 0 100
## 26.1244509694484 100 0
## 26.1357189552961 100 0
## 26.164140736913 100 0
## 26.2120918491575 0 100
## 26.2625462864123 0 100
## 26.2721714994893 100 0
## 26.3274266189917 100 0
## 26.4242536510418 100 0
## 26.4289592448212 100 0
## 26.4331584874122 100 0
## 26.4462809917355 0 100
## 26.451154653322 0 100
## 26.4610510054985 0 100
## 26.6132314724944 0 100
## 26.6294677855872 0 100
## 26.6532220784024 100 0
## 26.6983228484163 100 0
## 26.7022593143077 0 100
## 26.7435784553732 0 100
## 26.7533997859728 0 100
## 26.8242230649621 0 100
## 26.8268517689126 0 100
## 26.937225584431 0 100
## 27.005104599609 0 100
## 27.023922260635 100 0
## 27.0361285999712 100 0
## 27.0751124985436 100 0
## 27.0882228264803 0 100
## 27.0969482686587 0 100
## 27.120315581854 0 100
## 27.1736493240555 0 100
## 27.2016538605547 100 0
## 27.2322926489507 100 0
## 27.308315703406 100 0
## 27.4076572777871 0 100
## 27.4108947442534 0 100
## 27.4627077949177 0 100
## 27.4798626452487 0 100
## 27.5791682421486 0 100
## 27.6500811249324 100 0
## 27.6877107322908 0 100
## 27.7180825402395 0 100
## 27.8306786703601 100 0
## 28.091037079063 100 0
## 28.2673643717308 0 100
## 28.3443454945897 0 100
## 28.3763231226204 0 100
## 28.4089914068638 0 100
## 28.5087272732969 0 100
## 28.7295259628216 0 100
## 28.8283155106512 0 100
## 28.8740718444402 0 100
## 28.9941062457972 0 100
## 29.2373620768343 0 100
## 29.3935790725327 0 100
## 29.3939801128729 100 0
## 29.5042815072497 0 100
## 29.5761697746395 0 100
## 29.6485457063712 0 100
## 29.7126963278551 0 100
## 29.9230892485179 0 100
## 29.9986842682339 100 0
## 30.0102731941657 100 0
## 30.0492160666334 100 0
## 30.1368295132325 100 0
## 30.3715976331361 100 0
## 30.6784042740255 0 100
## 32.8929888747919 0 100
## 33.0970609077475 0 100
## 33.5825323365373 0 100
## 33.9193849284866 0 100
## 34.3079582748285 0 100
## 35.5212959958829 0 100
## 36.7086034651708 0 100# Estas variables están relacionadas de manera significativa- Crear un objeto llamado modelog que tendrá los cálculos del modelo lógistico
#modelog <- glm(dnutricion$target~ dnutricion$IMC, data = dnutricion, family="binomial")
modelog <- glm(dnutricion$target~ dnutricion$IMC, data = dnutricion, family="binomial")Revisando la composición del modelo
names(modelog)## [1] "coefficients" "residuals" "fitted.values"
## [4] "effects" "R" "rank"
## [7] "qr" "family" "linear.predictors"
## [10] "deviance" "aic" "null.deviance"
## [13] "iter" "weights" "prior.weights"
## [16] "df.residual" "df.null" "y"
## [19] "converged" "boundary" "model"
## [22] "call" "formula" "terms"
## [25] "data" "offset" "control"
## [28] "method" "contrasts" "xlevels"- Definir fórmula del modelo de regresión logística log(p/1-p)= b0 + b1(x1)
Revisamos si la variable independinte es suficientemente explicativa para poder predecir a nuestra variable dependiente
Para esto se revisa los valores entregados del modelo
summary(modelog)##
## Call:
## glm(formula = dnutricion$target ~ dnutricion$IMC, family = "binomial",
## data = dnutricion)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.8428 -0.5879 -0.4026 -0.2516 2.8347
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -11.26529 1.04341 -10.797 <2e-16 ***
## dnutricion$IMC 0.42016 0.04347 9.665 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 628.55 on 651 degrees of freedom
## Residual deviance: 495.04 on 650 degrees of freedom
## AIC: 499.04
##
## Number of Fisher Scoring iterations: 5oefficients: Estimate Std. Error z value Pr(>|z|)
(Intercept) -3.686638 0.513161 -7.184 6.76e-13
dnutricion$pc1 -0.017139 0.003779 -4.535 5.76e-06
Prueba de Hipótesis H0: variable x no aporta para predecir y Ha: variable x si aporta para predecir y
dado que el pvalor es menor que 0.05 Podemos concluir que nuestra variable independiente tiene la capacidad de predecir a la variable dependiente
- Revisamos los valores de los coeficientes Odd Ratio
exp(modelog$coefficients)## (Intercept) dnutricion$IMC
## 1.280992e-05 1.522213e+00Interpretación: Odds Ratio de la variable independiente es 1.52 por cada unidad que aumenta la variable IMC, el odds que se presente el evento de diabetes aumenta 1.5 veces, es decir aumenta un 50%
Otra forma para determinar la capacidad predictora de las variable independiente
# con pROC
# La variable independiente ingresa como numérico
library(pROC)## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following object is masked from 'package:colorspace':
##
## coords## The following objects are masked from 'package:stats':
##
## cov, smooth, varROC1 <- roc(dnutricion$IMC~as.numeric(dnutricion$target))## Warning in roc.default(response, predictors[, 1], ...): 'response' has more
## than two levels. Consider setting 'levels' explicitly or using 'multiclass.roc'
## instead## Setting levels: control = 14.5378861653136, case = 15.7611527668217## Setting direction: controls < casesprint("Nivel predictibilidad de esta variable independiente sobre la variable dependiente es: ")## [1] "Nivel predictibilidad de esta variable independiente sobre la variable dependiente es: "print(ROC1)##
## Call:
## roc.formula(formula = dnutricion$IMC ~ as.numeric(dnutricion$target))
##
## Data: as.numeric(dnutricion$target) in 1 controls (dnutricion$IMC 14.5378861653136) < 1 cases (dnutricion$IMC 15.7611527668217).
## Area under the curve: 0.5print("Intervalo de confianza de la curva ROC")## [1] "Intervalo de confianza de la curva ROC"print(ci.auc(ROC1))## 95% CI: NA-NA (DeLong)plot(ROC1)
- observar las probabilidades que el modelo clasifique o no el evento Analizamos la variable fitted.values (valores ajustados)
modelog$fitted.values## 1 2 3 4 5 6
## 0.761619837 0.133724254 0.101576955 0.174778122 0.128718723 0.428319561
## 7 8 9 10 11 12
## 0.018188722 0.035882419 0.974901167 0.019957817 0.028779627 0.054935839
## 13 14 15 16 17 18
## 0.050479139 0.032203492 0.130401329 0.661765834 0.032967201 0.029735707
## 19 20 21 22 23 24
## 0.192336765 0.984607759 0.195923661 0.417219636 0.198835236 0.076161298
## 25 26 27 28 29 30
## 0.409938717 0.032797769 0.311530860 0.061273366 0.035207817 0.067183032
## 31 32 33 34 35 36
## 0.054679528 0.259776838 0.064818413 0.057447821 0.544076713 0.100101360
## 37 38 39 40 41 42
## 0.091841188 0.079602879 0.213153795 0.700012760 0.532383815 0.018238370
## 43 44 45 46 47 48
## 0.029788810 0.269240311 0.045740711 0.267376844 0.107317075 0.060290963
## 49 50 51 52 53 54
## 0.090477716 0.148773238 0.067287848 0.099615726 0.394105333 0.192248605
## 55 56 57 58 59 60
## 0.088742651 0.016667092 0.314937772 0.120323237 0.054033850 0.276284596
## 61 62 63 64 65 66
## 0.077385702 0.125239351 0.747413079 0.070320652 0.162388633 0.076462908
## 67 68 69 70 71 72
## 0.153417903 0.154678342 0.280012669 0.065653435 0.027376126 0.017966173
## 73 74 75 76 77 78
## 0.816945992 0.075614056 0.567971103 0.077690096 0.135881322 0.073727704
## 79 80 81 82 83 84
## 0.218465056 0.207678580 0.365154265 0.400506984 0.256318557 0.086649560
## 85 86 87 88 89 90
## 0.390834931 0.122823229 0.097591487 0.056645640 0.028496399 0.020264040
## 91 92 93 94 95 96
## 0.061389724 0.131962991 0.432407732 0.237979808 0.192577016 0.145218880
## 97 98 99 100 101 102
## 0.121987096 0.050031354 0.185782286 0.213239593 0.795814675 0.045721432
## 103 104 105 106 107 108
## 0.562286708 0.213696766 0.167378444 0.155478308 0.169439639 0.045823897
## 109 110 111 112 113 114
## 0.331721566 0.034355586 0.419814343 0.130192628 0.042899423 0.050506651
## 115 116 117 118 119 120
## 0.125473681 0.176390702 0.067520668 0.523568626 0.111266196 0.105131805
## 121 122 123 124 125 126
## 0.136210848 0.043193539 0.060383771 0.105914544 0.277022095 0.095296650
## 127 128 129 130 131 132
## 0.031149633 0.223664222 0.163965423 0.704034368 0.163114767 0.039058536
## 133 134 135 136 137 138
## 0.130295428 0.077408598 0.117987146 0.513194145 0.463245653 0.204753124
## 139 140 141 142 143 144
## 0.339087668 0.437359104 0.334383158 0.691224613 0.792342985 0.220905230
## 145 146 147 148 149 150
## 0.488518077 0.074226209 0.272240715 0.084007351 0.105803684 0.587176613
## 151 152 153 154 155 156
## 0.201092115 0.363341635 0.238117468 0.196036727 0.168691567 0.225209194
## 157 158 159 160 161 162
## 0.181129358 0.282868501 0.256316683 0.037178245 0.114771781 0.014397138
## 163 164 165 166 167 168
## 0.376426291 0.092161899 0.040209792 0.032437406 0.044438258 0.085364349
## 169 170 171 172 173 174
## 0.080969980 0.200017055 0.218437916 0.040844418 0.030972955 0.317719141
## 175 176 177 178 179 180
## 0.182615692 0.027512267 0.041291343 0.044188375 0.144734768 0.009536885
## 181 182 183 184 185 186
## 0.158920008 0.202240063 0.046800365 0.022189374 0.141542019 0.059205063
## 187 188 189 190 191 192
## 0.053034721 0.958897400 0.052468782 0.159149107 0.109999600 0.031183852
## 193 194 195 196 197 198
## 0.066058416 0.125657609 0.052101607 0.150391537 0.073141853 0.222441254
## 199 200 201 202 203 204
## 0.034405166 0.015049736 0.148053735 0.228970619 0.022289947 0.141363568
## 205 206 207 208 209 210
## 0.161999690 0.019350007 0.069879303 0.174286105 0.052551226 0.028738902
## 211 212 213 214 215 216
## 0.095101533 0.315483421 0.551988401 0.129494722 0.171596605 0.101295570
## 217 218 219 220 221 222
## 0.155366899 0.021315458 0.787068410 0.051962239 0.138108558 0.046044106
## 223 224 225 226 227 228
## 0.039495630 0.036647619 0.014338118 0.107592135 0.114983103 0.043901084
## 229 230 231 232 233 234
## 0.054622397 0.041118541 0.492856758 0.105492044 0.273691437 0.070313702
## 235 236 237 238 239 240
## 0.045566070 0.194108547 0.081652792 0.110982521 0.242345815 0.031475369
## 241 242 243 244 245 246
## 0.161186193 0.081958486 0.157961842 0.835442457 0.057167373 0.202263213
## 247 248 249 250 251 252
## 0.258370773 0.035872286 0.054128761 0.228221856 0.158635365 0.041047007
## 253 254 255 256 257 258
## 0.579935999 0.793143011 0.106844910 0.072150350 0.068418668 0.074887744
## 259 260 261 262 263 264
## 0.113683467 0.132153575 0.271761945 0.747444889 0.184382960 0.136863780
## 265 266 267 268 269 270
## 0.294799117 0.016057643 0.093804187 0.122563584 0.410184875 0.157961842
## 271 272 273 274 275 276
## 0.017991174 0.070486971 0.060299112 0.767096900 0.066773288 0.166729049
## 277 278 279 280 281 282
## 0.051893701 0.276012872 0.234813046 0.168854478 0.017955346 0.213738159
## 283 284 285 286 287 288
## 0.074943268 0.212524670 0.177419096 0.159821275 0.058475419 0.094546884
## 289 290 291 292 293 294
## 0.057035176 0.126896025 0.147272106 0.260647339 0.159442948 0.302979824
## 295 296 297 298 299 300
## 0.529025477 0.143330461 0.186173899 0.124287827 0.034259360 0.050752443
## 301 302 303 304 305 306
## 0.056084117 0.111492871 0.605440549 0.081126827 0.030439346 0.540881617
## 307 308 309 310 311 312
## 0.488104812 0.182465330 0.115730889 0.045376238 0.062802144 0.402608402
## 313 314 315 316 317 318
## 0.134994783 0.087937358 0.066861527 0.200629033 0.655659671 0.082626610
## 319 320 321 322 323 324
## 0.237980160 0.501327280 0.109829418 0.119903282 0.049010371 0.344623225
## 325 326 327 328 329 330
## 0.229710468 0.133000971 0.076519659 0.183135900 0.250609245 0.034408056
## 331 332 333 334 335 336
## 0.026981445 0.045136041 0.117466730 0.055712191 0.054771273 0.095362025
## 337 338 339 340 341 342
## 0.146030630 0.349414663 0.105054739 0.256548266 0.927921550 0.177196112
## 343 344 345 346 347 348
## 0.080165187 0.062672526 0.045570076 0.116393323 0.120709741 0.070831750
## 349 350 351 352 353 354
## 0.404141530 0.128464967 0.054684990 0.075626830 0.449317824 0.100312188
## 355 356 357 358 359 360
## 0.771877745 0.045935789 0.282965378 0.131607224 0.098828814 0.207711165
## 361 362 363 364 365 366
## 0.045508934 0.150396513 0.405745267 0.096355604 0.083430655 0.187999140
## 367 368 369 370 371 372
## 0.177845134 0.038733971 0.112632123 0.099170117 0.279953415 0.113743663
## 373 374 375 376 377 378
## 0.350317291 0.520316114 0.043259469 0.039496675 0.209818530 0.170758380
## 379 380 381 382 383 384
## 0.274222193 0.033648629 0.147086203 0.121092698 0.187963250 0.156698591
## 385 386 387 388 389 390
## 0.200150801 0.077338393 0.479176514 0.258767208 0.217335154 0.117943450
## 391 392 393 394 395 396
## 0.347965420 0.172200969 0.215572999 0.048797048 0.030869564 0.053072880
## 397 398 399 400 401 402
## 0.078262629 0.058173121 0.161314911 0.052040059 0.204917890 0.529938821
## 403 404 405 406 407 408
## 0.397456500 0.176238493 0.631249293 0.023799183 0.020373786 0.079730963
## 409 410 411 412 413 414
## 0.103996613 0.097927387 0.059907586 0.083740672 0.051417130 0.179315253
## 415 416 417 418 419 420
## 0.042955469 0.083659902 0.107877547 0.260212533 0.099725680 0.096362766
## 421 422 423 424 425 426
## 0.080152572 0.180163124 0.035907397 0.138993474 0.042186155 0.113736176
## 427 428 429 430 431 432
## 0.048096403 0.591003762 0.078141578 0.107457814 0.199344764 0.150521541
## 433 434 435 436 437 438
## 0.671081112 0.537958278 0.015725668 0.169035110 0.028954474 0.161344296
## 439 440 441 442 443 444
## 0.240070231 0.501603400 0.025670746 0.020802405 0.152529344 0.019873439
## 445 446 447 448 449 450
## 0.236883642 0.069527156 0.118584874 0.200929150 0.027051674 0.066531774
## 451 452 453 454 455 456
## 0.053762888 0.383991638 0.034908220 0.087085460 0.085364349 0.269928874
## 457 458 459 460 461 462
## 0.092921816 0.046073198 0.323383432 0.285408686 0.082766606 0.084566544
## 463 464 465 466 467 468
## 0.087540993 0.026367542 0.124611939 0.042200693 0.036959959 0.092428342
## 469 470 471 472 473 474
## 0.086504564 0.085675096 0.035123262 0.074315325 0.164347633 0.043657512
## 475 476 477 478 479 480
## 0.383326324 0.156285905 0.233943974 0.087327937 0.933450134 0.309716255
## 481 482 483 484 485 486
## 0.037974404 0.098251101 0.021983458 0.206845964 0.059656525 0.532383815
## 487 488 489 490 491 492
## 0.075336575 0.077978343 0.155656204 0.079841399 0.051326587 0.042171203
## 493 494 495 496 497 498
## 0.161474728 0.053063697 0.118331043 0.058809310 0.069150266 0.083970292
## 499 500 501 502 503 504
## 0.078723340 0.168561876 0.107910304 0.030859454 0.945055191 0.128631004
## 505 506 507 508 509 510
## 0.195361044 0.010855214 0.191250607 0.038866443 0.182289122 0.022948619
## 511 512 513 514 515 516
## 0.174509076 0.060248987 0.178577317 0.493888222 0.096150982 0.049895478
## 517 518 519 520 521 522
## 0.132569209 0.065172628 0.038562377 0.033443328 0.376995047 0.128690470
## 523 524 525 526 527 528
## 0.714434131 0.340843399 0.068284570 0.658686715 0.281480032 0.562621470
## 529 530 531 532 533 534
## 0.047150420 0.133732430 0.483371261 0.265259537 0.292500282 0.097852689
## 535 536 537 538 539 540
## 0.052876885 0.053170505 0.082459399 0.139629074 0.074728122 0.227707966
## 541 542 543 544 545 546
## 0.052656124 0.110788621 0.091232017 0.233632413 0.215275445 0.459894621
## 547 548 549 550 551 552
## 0.140447514 0.429479230 0.005726091 0.155092453 0.130249807 0.167498319
## 553 554 555 556 557 558
## 0.066397026 0.480879274 0.127328586 0.443580401 0.059448272 0.078922991
## 559 560 561 562 563 564
## 0.801731311 0.139212251 0.060266514 0.071164235 0.050982409 0.068939476
## 565 566 567 568 569 570
## 0.068821434 0.052857466 0.756092722 0.084375323 0.125433835 0.125620070
## 571 572 573 574 575 576
## 0.031936370 0.129214430 0.041069479 0.125539682 0.354982403 0.100470027
## 577 578 579 580 581 582
## 0.032236867 0.071870478 0.016460226 0.037704802 0.086935122 0.461702932
## 583 584 585 586 587 588
## 0.021015192 0.096109294 0.055199207 0.046927153 0.265440535 0.170572997
## 589 590 591 592 593 594
## 0.073199472 0.075337622 0.205228428 0.031156465 0.129424441 0.233689168
## 595 596 597 598 599 600
## 0.239035778 0.951958114 0.077990079 0.174477590 0.164848739 0.299320048
## 601 602 603 604 605 606
## 0.113345497 0.247177217 0.297605365 0.459403558 0.128594775 0.190950747
## 607 608 609 610 611 612
## 0.064364412 0.119037071 0.374365813 0.115629267 0.017758584 0.110293741
## 613 614 615 616 617 618
## 0.124851843 0.093963303 0.460332907 0.166311031 0.426308221 0.243160921
## 619 620 621 622 623 624
## 0.366432422 0.172430069 0.344796940 0.124851843 0.082892415 0.126794488
## 625 626 627 628 629 630
## 0.074612316 0.648320880 0.202092507 0.197601862 0.734821743 0.137623503
## 631 632 633 634 635 636
## 0.527652777 0.055611043 0.202554903 0.462211904 0.047803369 0.132592266
## 637 638 639 640 641 642
## 0.357788952 0.594084750 0.243584481 0.045525158 0.242100806 0.442582459
## 643 644 645 646 647 648
## 0.042140777 0.173321289 0.569738895 0.208548661 0.274817847 0.080952094
## 649 650 651 652
## 0.175664302 0.154678342 0.522289154 0.172112525- Se define el punto de corte Para esto creamos una nueva variable que agregamos a la data original
str(dnutricion)## 'data.frame': 652 obs. of 20 variables:
## $ talla : num 156 166 151 152 160 ...
## $ edad : num 16 16 16 16 16 16 16 16 16 16 ...
## $ peso_kg : num 71.2 61 49.1 54.6 58 70.8 47.4 49.3 91 50.4 ...
## $ circun_cuello : num 35.7 31.8 30.5 32.6 30.1 33.9 30.5 31.2 37.5 30.8 ...
## $ IMC : num 29.6 22.4 21.6 23.1 22.3 ...
## $ circun_cintura : num 90 80.9 72 74.4 79.6 ...
## $ cadera : num 98 100.5 86 88.4 97.9 ...
## $ ind_cintura_cadera : num 0.918 0.805 0.837 0.842 0.813 ...
## $ ind_cintura_estatura : num 0.578 0.486 0.476 0.49 0.497 ...
## $ por_grasa_corporal : num 36.4 28.8 29.9 27.9 30.3 ...
## $ masa_corporal_magra_kg : num 45.3 43.4 34.4 39.4 40.4 ...
## $ pliegue_cutaneo_BICEPS : num 13 5 13 5 10 11 3.5 5.5 25 3 ...
## $ pliegue_cutaneo_TRICEPS : num 27 19 18 19 19 25 7 12 21 7 ...
## $ pliegue_cutaneo_ESCAPULAR : num 32 15 18 15 20 18 6 10.5 25 8.5 ...
## $ pliegue_cutaneo_SUPRAILIACO: num 34 22 17 18 19 20 6 11.5 15 9 ...
## $ target : num 1 0 0 0 1 0 1 0 1 0 ...
## $ pc1 : num -137 -129 -120 -116 -139 ...
## $ pc2 : num -54.1 68.5 -125.9 -30.1 -22.6 ...
## $ pc3 : num 17.5 55.3 93.5 -46.3 66 ...
## $ pc4 : num 5.04 -196.94 43.7 51.83 24.57 ...#dx1$predicho<- as.numeric(modelog$fitted.values>=0.5)
dx2<-dnutricion
dx2$target<-as.factor(dx2$target)
levels(dx2$target) = c('NO', 'SI')
str(dx2)## 'data.frame': 652 obs. of 20 variables:
## $ talla : num 156 166 151 152 160 ...
## $ edad : num 16 16 16 16 16 16 16 16 16 16 ...
## $ peso_kg : num 71.2 61 49.1 54.6 58 70.8 47.4 49.3 91 50.4 ...
## $ circun_cuello : num 35.7 31.8 30.5 32.6 30.1 33.9 30.5 31.2 37.5 30.8 ...
## $ IMC : num 29.6 22.4 21.6 23.1 22.3 ...
## $ circun_cintura : num 90 80.9 72 74.4 79.6 ...
## $ cadera : num 98 100.5 86 88.4 97.9 ...
## $ ind_cintura_cadera : num 0.918 0.805 0.837 0.842 0.813 ...
## $ ind_cintura_estatura : num 0.578 0.486 0.476 0.49 0.497 ...
## $ por_grasa_corporal : num 36.4 28.8 29.9 27.9 30.3 ...
## $ masa_corporal_magra_kg : num 45.3 43.4 34.4 39.4 40.4 ...
## $ pliegue_cutaneo_BICEPS : num 13 5 13 5 10 11 3.5 5.5 25 3 ...
## $ pliegue_cutaneo_TRICEPS : num 27 19 18 19 19 25 7 12 21 7 ...
## $ pliegue_cutaneo_ESCAPULAR : num 32 15 18 15 20 18 6 10.5 25 8.5 ...
## $ pliegue_cutaneo_SUPRAILIACO: num 34 22 17 18 19 20 6 11.5 15 9 ...
## $ target : Factor w/ 2 levels "NO","SI": 2 1 1 1 2 1 2 1 2 1 ...
## $ pc1 : num -137 -129 -120 -116 -139 ...
## $ pc2 : num -54.1 68.5 -125.9 -30.1 -22.6 ...
## $ pc3 : num 17.5 55.3 93.5 -46.3 66 ...
## $ pc4 : num 5.04 -196.94 43.7 51.83 24.57 ...valores_predichos<- as.numeric(modelog$fitted.values>=0.5)
table(valores_predichos)## valores_predichos
## 0 1
## 597 55valores_predichos<- factor(valores_predichos, labels = levels(dx2$target))
table(valores_predichos)## valores_predichos
## NO SI
## 597 55- Evaluamos el modelo para determinar si está clasificando bien los valores predichos
Usaremos una matriz de confusión o de contigencia
La librería caret nos proporciona también la precisión, la sensibilidad y la especificidad del modelo de regresión logística
library(caret)##
## Attaching package: 'caret'## The following object is masked from 'package:purrr':
##
## lift## The following object is masked from 'package:mlr':
##
## train## The following object is masked from 'package:survival':
##
## clustercaret::confusionMatrix(valores_predichos, dx2$target, positive='SI')## Confusion Matrix and Statistics
##
## Reference
## Prediction NO SI
## NO 515 82
## SI 15 40
##
## Accuracy : 0.8512
## 95% CI : (0.8216, 0.8777)
## No Information Rate : 0.8129
## P-Value [Acc > NIR] : 0.005881
##
## Kappa : 0.3799
##
## Mcnemar's Test P-Value : 2.066e-11
##
## Sensitivity : 0.32787
## Specificity : 0.97170
## Pos Pred Value : 0.72727
## Neg Pred Value : 0.86265
## Prevalence : 0.18712
## Detection Rate : 0.06135
## Detection Prevalence : 0.08436
## Balanced Accuracy : 0.64978
##
## 'Positive' Class : SI
## Interpretación: El modelo tiene un 85% de precisión al predecir diabetes Tiene una sensibilidad : de 32% (Casos predichos positivos que son positivos) Tiene una Especificidad : de 97% (Casos predichos negativos que son negativos)